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ABSTRACT 


A  central  data  exchange  facility  was  organized  at  Hawaii  Institute  of 
Geophysics  to  manage  seismic  data  collected  during  project  ROSE  (the  Rivera 
Ocean  Seismic  Experiment),  a  large  marine  seismic  experiment.  Prior  to  that 
experiment,  wide  consultation  was  made  and  much  effort  was  expended  in  the 
establishment  of  a  uniform,  yet  flexible,  data  exchange  format.  The 
participating  institutions  provided  their  data  to  the  facility  where  the  data 
were  catalogued  and  distributed.  This  report  describes  in  detail  the 
processes  and  computer  programs  used  to  catalog,  store  and  distribute  the 
ROSE  seismic  data.  The  users  and  I  hope  that  exchange  of  data  from  other 
experiments  will  be  facilitated  by  use  of  the  ROSE  format  and  these  programs. 
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I.  Description  of  ROSE  Experiment 


A.  Introduction 


During  early  1979  a  consortium  of  universities  and  government 
agencies  from  the  United  States  and  Mexico  conducted  the  Riveria 
Ocean  Seismic  Experiment  (ROSE),  a  seismological  and  acoustical 
experiment  off  the  western  coast  of  Mexico.  An  overview  of  the 
three  phases  of  the  experiment,  active  (controlled  source),  passive 
(earthquake  and  microseismicity),  and  land  based,  is  given  by  Ewing 
and  Meyer  [1982].  Twelve  research  groups  deployed  instruments  at 
sea,  and  two  groups  deployed  instruments  on  land. 

Effective  use  of  the  large  data  set  generated  by  the  experiment 
required  a  data  storage  and  exchange  facility.  The  ROSE  data 
exchange  format  was  designed  to  enable  exchange  and  processing  on 
the  various  computer  systems  used  by  each  research  group.  Because 
instrumentation  for  the  experiment  was  not  uniform,  instrument 
parameters  were  defined  and  quantified  in  such  a  way  that  the  data 
recorded  by  the  instrument  could  be  compared.  Further,  a  concise 
identification  scheme  for  both  control led-source  and  natural  seismic 
events  was  developed.  The  data  exchange  and  storage  medium  is 
industry-standard  magnetic  tape,  and  event-instrument  pairs  are 
catalogued  on  disk  files.  The  combination  of  an  easily  read  data 
exchange  format  and  effective  cataloging  system  has  made  the  ROSE 
Data  Exchange  Facility  viable.  The  Facility  is  based  on  the  Harris 
H800  computer  system  at  Hawaii  Institute  of  Geophysics  (HIG).  A 
brief  description  of  the  exchange  format  and  the  operation  of  the 
Facility  is  given  in  LaTraille  et  al .  [1982]. 

The  data  storage  and  retrieval  procedures  developed  for  the  ROSE 
experiment  are  expected  to  be  applicable  to  future  experiments.  This 
technical  report  contains  complete  listings  of  programs  used, 
reports,  forms,  and  detailed  descriptions  of  procedures  and  the  tape 
format.  Samples  of  the  tape  header  and  file  header  records  are 
shown  in  tabular  form  to  provide  the  information  associated  with  each 
instrument  and  each  seismic  event. 

B.  Size  of  the  Data  Base 

The  initial  estimate  of  the  number  of  events  to  be  included  in 
the  data  base  was  180,000.  An  "event"  is  defined  as  one  event 
recorded  by  one  instrument.  This  number  was  based  on  detonating 
about  2000  shots  to  76  OBS's  during  Phase  I  of  the  experiment,  and 
380  shots  to  62  OBS's  during  Phase  II.  A  65%  return  rate  of  useful 
data  was  estimated.  These  calculations  accounted  for  about  100,000 
events.  The  other  80,000  were  to  be  earthquakes  recorded  both  on 
OBS's  and  land  instruments.  Programs  and  procedures  were  designed  to 
handle  this  amount  of  data.  As  it  turned  out,  the  Exchange  Facility 
was  not  asked  to  archive  the  land  earthquakes,  and  the  number  of 
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useful  events  sent  to  the  Facility  was  under  25,000  as  of  this 
report . 

II*  The  Rose  Storage  and  Exchange  Format 

A  word  about  terminology:  in  this  report  we  will  use  the  terms 
"archive"  and  "storage"  interchangably .  The  ROSE  tape  storage  and  exchange 
format  was  originally  called  the  "Archive"  format,  but  because  it  s  main 
design  feature  is  ease  of  data  exchange  between  researchers  and  because  it  is 
not  the  most  efficient  format  for  data  storage,  it  has  been  popularly 
referred  to  as  the  ROSE  seismic  data  exchange  format  (see  also  LaTraille  and 
Dorman,  1983).  Nevertheless,  both  the  Facility  and  the  Format  will  be 
referred  to  with  the  term  "Archive"  in  this  report.  A  detailed  description 
of  the  Format  follows: 

The  storage  and  exchange  medium  is  9-track  digital  magnetic  tape  which 
has  an  external  tape  label  containing  the  following  information: 

1)  Instrument  identification  number. 

2)  Recording  time  window  -  this  is  the  beginning  and  ending  time  covered 

by  this  tape. 

3)  Tape  format,  e.g.,  IBM  NRZI  @  800  bpi  or  IBM  PE  @  1600  bpi. 

4)  Tape  length  and  thickness,  e.g.,  2400  ft.,  1-1/2  mil. 

5)  ASCII  or  EBCDIC  code. 

The  essential  aspect  of  the  data  exchange  format  is  to  block  the  data 
into  manageable  segments  and  to  identify  the  data  attributes  by  a  preceding 
header.  The  format  is  illustrated  in  Figure  1  and  the  contents  of  each 
record  are  described  below. 

A*  The  Tape  Header  File 

The  first  file  on  the  tape  is  a  "tape  header"  file  which  provides 
descriptive  information  about  the  tape  format,  the  data  representation,  and 
the  instrument  that  generated  the  data.  It  is  written  in  alphanumeric  format 
because  a  large  portion  of  the  file  contains  text  information.  This  file  is 
actually  a  single  256-word  record  followed  by  an  end-of-file  mark.  Table  1 
illustrates  the  sample  contents  of  a  tape  header.  Each  word  group  is 
described  below: 


Words  Contents 

1-2  Instrument  Identification  Number.  (A  range  of  Instrument 

Identification  numbers  was  assigned  to  each  institution.  The 
instrument  description  including  response  functions  is  on  file  with 
the  data  exchange  center.) 

3-30  Instrument  designer's  name  and  address,  or  originating  institution 
name  and  address. 

31  -  40  Experiment  code,  e.g.,  POSE  PHASE  I. 

41  -  45  Year,  month,  day,  hour,  and  minute  of  start  of  data,  e.g., 

27  February  1979  @  08:16  =  7902270816. 


3 


46  -  50  Year,  month,  day,  hour  and  minute  of  end  of  data. 

51  -  54  Number  of  files  on  tape  exclusive  of  Tape  Header  (i.e.,  number  of 
events ) . 

55  -256  Not  used. 
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fully  described  with  one  data  record.  An  EOF  is  a  hardware  end-of-file  mark.  An  ERG  is  an 
end-of-record  gap.  The  tape  header  is  in  alphanumeric  format  (ASCII  or  EBCDIC) .  The  data 
in  16-  or  32-bit  twos-complement  integer  format  (4096-  or  2048-word  records) . 
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TABLE  1. 

★ 

Sample  contents  of  tape  header  file 

Word 

Number 

Field  Description 

Value 

1-2 

Instrument  I.D.  Number 

302 

3-30 

Designer  name  and  address 

WA  Prothero,  UC  Santa 
Barbara 

31-40 

Experiment  code 

ROSE  Phase  I 

41-45 

Year,  month,  day,  hour  and  minute 
of  start  of  data 

7902020100 

46-50 

Year,  month,  day,  hour  and  minute 
of  end  of  data 

7902051200 

51-54 

Number  of  files  on  tape  exclusive 
of  tape  header  (i.e.,  number  of 
events) 

107 

55-256 

Blank 

All  information  alphanumeric  (left  justified). 
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B.  File  Header  Record  and  Data  Structure 

The  data  section  consists  of  a  sequence  of  files  each  of  which 
contains  its  own  "file  header  record”  followed  by  a  data  record(s)  for  each 
component ,  or  channel,  in  the  instrument.  Optional  additional  headers  can 
be  used  for  instruments  with  more  than  10  channels.  The  header  is  in 
integer  format  because  almost  all  the  data  are  numerical,  and  each  header  is 
256  words  long. 

Each  data  record  is  4096  words  long.  This  size  was  chosen  because  most 
minicomputers  can  accommodate  it  in  their  I/O  buffers.  If  a  particular 
event  requires  more  than  4096  words,  the  first  4096— word  record  is  followed 
immediately  with  records  2,  3,  ...  until  the  event  is  described  (see  Figure 
1).  All  samples  from  component  1  are  written  before  going  onto  component  2. 
Thus,  all  of  the  data  for  an  event  are  contained  within  a  single  file.  Each 
file  contains  a  number  of  data  records  equal  to  the  number  of  components 
times  the  number  of  data  records  per  component.  If  a  data  record  contains 
less  than  4096  samples,  the  record  is  padded  with  zeros.  Words  #71  and  #72 
in  the  header  record  are  particularly  important.  Word  #71  specifies  the 
number  of  records  required  to  fully  describe  an  event  for  one  component; 
word  #72  specifies  the  number  of  non-zero  samples  in  the  last  record  of  that 
component.  The  data  are  in  twos-complement  16-bit  integer  format.  Scales 
have  been  chosen  so  that  a  16-bit  word  does  not  overflow.  The  format  can 
also  accommodate  32-bit  integer  data  words,  and  in  this  case  each  record 
would  contain  2048  data  words.  The  sensitivities  of  the  instruments,  the 
electronics  gains  and  the  value  of  the  least  significant  bit  are  specified 
in  the  header  in  order  to  preserve  quantitative  signal  levels.  The  contents 
of  the  file  header  record  are  described  below  and  a  sample  is  shown  in  Table 
2. 

Words  Contents 

1  Instrument  Identification  number.  (This  should  be  the  integer 
equivalent  of  the  identification  number  on  the  tape  header  so  an 
instrument  will  have  an  alphanumeric  and  an  integer 
representation  on  the  same  tape.) 

2  Code  for  earthquake  or  shot  data.  If  earthquake,  set  *  1;  if  shot, 
set  =  2. 

3  Earthquake  or  shot  number.  Shots  are  given  specific  numbers  during 
an  experiment.  Numbers  for  earthquakes  are  simply  a  convenience 
the  true  identifier  for  an  earthquake  is  its  time. 

4  Year  of  first  sample  in  file;  2-digit  representation. 

5  Month  of  first  sample  in  file. 

6  Day  of  first  sample  in  file. 

7  Hour  of  first  sample  in  file. 

8  Minute  of  first  sample  in  file. 


9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 

30 
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Seconds  of  first  sample  in  file. 

Millisecs  of  first  sample  in  file.  (All  times  UTC  and  corrected  to 
WWV. ) 

Range  in  whole  megameters  between  event  and  instrument. 

Remainder  of  range  in  whole  kilometers  between  event  and 
instrument . 

Remainder  of  range  in  whole  meters  between  event  and  instrument. 

Estimate  of  error  in  range  in  meters.  As  the  method  of  computing 
the  range  may  be  subject  to  error  and  may  vary  according  to  method, 
information  describing  the  calculation  method  and  the  sound  speed 
data  used  is  filed  with  the  exchange  center. 

Instrument  latitude  in  degrees. 

Fractional  part  of  instrument  latitude  in  millidegrees. 

Instrument  longitude  in  degrees. 

Fractional  part  of  instrument  longitude  in  millidegrees. 

Instrument  depth  in  meters. 

Normal  incidence  (vertical)  travel  time  from  surface  to  instrument 
(millisecs ) . 

Shot  or  earthquake  latitude  in  degrees. 

Fractional  part  of  shot  or  earthquake  latitude  in  millidegrees. 

Shot  or  earthquake  longitude  in  degrees. 

Fractional  part  of  shot  or  earthquake  longitude  in  millidegrees. 

Error  radius  in  event  location  in  meters.  As  the  method  of 
computing  the  event  location  may  be  subject  to  error  and  may  vary 
according  to  the  available  information,  e.g.,  satellite  or  LORAN 
for  shots,  some  documentation  describing  the  estimation  method  and 
the  data  used  is  filed  with  the  data  exchange  center. 

Shot  depth  in  meters  or  epicenter  depth  in  kilometers. 

Water  depth  at  shot  or  earthquake  (in  meters). 

Year  of  shot  or  earthquake;  2-digit  representation. 

Month  of  shot  or  earthquake. 

Day  of  shot  or  earthquake. 
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31  Hour  of  shot  or  earthquake. 

32  Minute  of  shot  or  earthquake. 

33  Second  of  shot  or  earthquake. 

34  Mil lisec  of  shot  or  earthquake.  (All  times  in  UTC  corrected  to 
WWV.) 

33  Code  for  explosive  type  used  (1  =  TOVEX,  2  *  dynamite,  3  = 

tetratol ,  4  =  SUS  (1.8  lbs.),  5  =  maxipulse,  6  »  airgun,  7  = 

T.N.T.,  8  =  open,  9  =  other). 

36  Shot  weight  in  1000  log1Q  W,  where  V  is  charge  weight  in  grams;  or 
10M  where  M  is  the  earthquake  magnitude. 

37  Bubble  pulse  period  in  millisecs. 

38  Sampling  rate  in  samples/sec. 

39  Number  of  digitized  components. 

40  Number  of  data  words  in  record  (  =  4096  for  16-bit  words  or  2048  for 
32-bit  words ) . 

41  File  number  within  tape. 

42-59  Blank  for  additions  and  changes. 

60  Code  for  duplicate  component  parameters  -  1  if  all  channels  have 
same  parameters  as  channel  1.  If  channel  parameters  individually 
coded,  this  code  -  0. 

61  Code  for  component  number  one,  e.g.,  1)  vertical,  2)  radial, 

3)  tangential,  4)  hydrophone,  5)  non-rotated  first  horizontal, 

6)  non-rotated  second  horizontal,  7)  water  wave  channel,  8)  time. 

62  Azimuth  of  non-rotated  first  horizontal  if  61  is  (5)  or  (6). 

63  Sensitivity  of  instrument  at  frequency  fQ.  (For  displacement 

instruments  -  milli  volts/millimicron;  for  velocity  instruments  - 
milli  volts /( cm/sec ) ,  or  volts  (m/sec),  and  for  hydrophones  - 
volts/micropascal.  The  detailed  response  curve  of  each  instrument 
is  on  file  with  the  exchange  center.) 

64  fp  in  milliHertz  -  the  frequency  at  which  the  above  sensitivity  of 
the  instrument  was  measured. 

63  Lower  cutoff  of  passband  in  instrument  amplifier  (Hz). 

66  Upper  cutoff  of  passband  in  instrument  amplifier  (Hz). 
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67 

Amplifier  gain  of  digitizing  filter  in  dB. 

68 

Lower  cutoff  of  passband  of  digitizing  filter  (Hz). 

69 

Upper  cutoff  of  passband  of  digitizing  filter  (Hz). 

70 

Value  of  the  low  order,  or  least  significant,  bit  of  the  16-  or  32- 
bit  integer  word  in  microvolts. 

71 

Number  of  records  in  component. 

72 

Number  of  samples  in  last  record. 

73-80 

Blank  for  changes  and  additions. 

81-100 

Repeat  content  of  words  61-80  for  the  second  component. 

101 

Continue  repeating  at  intervals  of  20  words  for  each  component 
in  the  instrument  as  required  up  to  10  components. 

If 

channel  parameters  for  more  than  10  components  (channels)  are  to  be 

encoded,  add  as  many  additional  256-word  records  as  needed  (one  for  each  12 
additional  components).  Encode  the  contents  of  words  61-80  for  the  11th 
component  in  words  1-20  of  the  new  header  record.  Continue  repeating  at 
intervals  of  20  words  for  each  additional  component  as  required.  Note:  if 
additional  event  header  records  are  used,  there  must  be  a  0  in  word  60  of 
the  main  event  header. 
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TABLE  2.  Sample  Contents  of  File  Header  Record 


Word 

Number  Field  Description  Value 


1  Instrument  I.D.  Number*  5 

2  Code  for  earthquake  or  shot  data*  If  earthquake, 

set^l,  if  shot,  set=2.  2 

3  Earthquake  or  shot  number.  3243 

4  Year  of  first  sample  in  file.  79 

3  Month  of  first  sample  in  file.  2 

6  Day  of  first  sample  in  file.  28 

7  Hour  of  first  sample  in  file.  0 

8  Minute  of  first  sample  in  file.  5 

9  Second  of  first  sample  in  file.  9 

10  Millisecond  of  first  sample  in  file.  310 

11  Range  in  whole  megameters  (between  event  and  instrument).  0 

12  Remainder  of  range  in  whole  kilometers.  24 

13  Remainder  of  range  in  whole  meters.  368 

14  Estimate  of  error  in  range  in  meters.  500 

15  Instrument  latitude  in  degrees.  15 

16  Fractional  part  of  instrument  latitude  in  millidegrees.  29 

17  Instrument  longitude  in  degrees.  -104 

18  Fractional  part  of  instrument  longitude  in  millidegrees.  -750 

19  Instrument  depth  in  meters.  2476 

20  Vertical  travel  time  from  surface  to  instrument  (msec).  1692 

21  Event  latitude  in  degrees.  15 

22  Fractional  part  of  event  latitude  in  millidegrees.  253 

23  Event  longitude  in  degrees.  -104 

24  Fractional  part  of  event  longitude  in  millidegrees.  -756 

25  Error  radius  in  event  location  in  meters.  0 

26  Shot  depth  in  meters;  or  epicenter  depth  in  kilometers.  41 

27  Water  depth  at  event  in  meters.  2681 

28  Year  of  shot  or  earthquake.  79 

29  Month  of  shot  or  earthquake.  2 

30  Day  of  shot  or  earthquake.  28 

31  Hour  of  shot  or  earthquake.  0 

32  Minute  of  shot  or  earthquake.  5 

33  Second  of  shot  or  earthquake.  9 

34  Millisecond  of  shot  or  earthquake.  342 

35  Code  for  explosive  type  used  (1  *  TOVEX,  2  =  dynamite, 

3  =  tetratol,  4  =  SUS  (1.8  lbs.),  5  =  maxipulse, 

6  =  airgun,  7  =  TNT,  8  =  open,  9  =  other).  3 

36  Shot  weight  in  1000  log^W,  where  W  is  charge  weight 

in  grams;  or  10M  where  M  is  the  earthquake  magnitude.  3434 

37  Bubble  pulse  period  in  milliseconds.  110 

38  Sampling  rate  in  samples/second.  100 

39  Number  of  digitized  components.  2 

40  Number  of  data  words  per  record.  4096 

41  File  number  within  tape.  2 

42-59  Blank. 
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C.  Shot  Instant  Data 

In  order  for  a  participant  to  complete  the  header  information  for  data 
recorded  on  his  instruments  from  shots  detonated  by  another  participant,  the 
former  must  have  shot  instant  times,  shot  locations  and  other  information 
pertinent  to  seismic  data  interpretation.  These  data  were  distributed  to 
participants  on  magnetic  tape.  The  file  consisted  of  one  81  character  record 
per  shot.  The  variables  and  their  Fortran  format  are  listed  below: 


Variable  Name 

Format  .(FORTRAN) 

Characters 

Shot  Number 

14 

4 

Shot  Instant:  Year;  2-digit  representation 

13 

3 

Month 

13 

3 

Day 

13 

3 

Hour 

13 

3 

Minute 

13 

3 

Second 

F7.3 

7 

Latitude 

F10.4 

10 

Longitude 

F10.4 

10 

Size  (KG) 

F10.3 

10 

Shot  Depth  (M) 

F6.1 

6 

Water  Depth  (MSEC) 

16 

6 

Bubble  Pulse  Period  (MSEC) 

15 

5 

Explosive  Type 

12 

2 

Shot  Instant  Correction 

F6.3 

6 

Although  this  format  has  not  been  very  widely  discussed  and  accepted  as 
the  ROSE  data  storage  and  exchange  format,  it  is  easily  readable  and  probably 
should  be  an  addendum  to  the  exchange  format. 

III.  Archival  and  Retrieval  Procedures 

A.  Archiving  the  Data 

ROSE  participants  send  their  data  to  the  Exchange  facility  on  9-track  800 
or  1600-bpi  digital  magnetic  tape  in  the  data  exchange  format.  The  tape 
header  file  and  the  event  header  records  from  each  tape  become  part  of  the 
"Catalog"  area  on  the  disc.  This  area  is  the  main  source  for  reports  on  the 
data  base  and  for  request  documentation.  The  Catalog  has  the  capability  of 
being  easily  sorted  by  'keywords',  and  it  is  backed  up  on  magnetic  tape. 

A  simplified  picture  of  archiving  is  shown  on  the  flow  chart  in  Figure  2. 
A  data  tape  is  received,  logged  in  and  its  receipt  is  acknowledged.  Any 
accompanying  documentation  is  filed.  Next  the  tape  is  read  onto  disc  and 
verified  as  to  format.  Archiving  information  is  added  to  the  tape  header  file 
(descriptor  file).  Then  the  headers  and  data  are  written  to  an  archive  tape 
in  ROSE  format.  The  header  information  is,  at  the  same  time,  merged  with  the 
Catalog  and  an  archiving  summary  report  is  printed  (ROSE  Archive  Report  #1, 
Appendix  A).  The  archive  tape  is  then  verified,  labelled,  logged  and  stored. 
The  original  tape  is  recycled  for  use  in  the  data  archive  system.  The  format 
of  the  data  stored  on  ROSE  Archive  tapes  will  be  identical  to  the  official 
ROSE  data  archive  format;  however,  tapes  will  have  an  additional  Exchange 


ROSE  Data  Archive  System 
Archiving  Incoming  Tapes 


Figure  2.  Flow  chart  of  the  procedures  for  processing  and  storage 
of  digital  seismic  data. 
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Facility  tape  header  at  the  beginning  which  will  contain  the  following 
information: 

1.  Tape  #  in  form  of  RARCnnnn,  where  n's  are  integers 

2.  Date  archived 

3.  Date  received  source  tape 

4.  Institution  received  from 

5#  Key  for  documentation  on  file 

6.  Keyword  value  ranges 

This  gives  us  a  double  check  system  on  the  archive  tapes,  and  makes 
determination  of  what  is  on  the  tape  simple  and  efficient.  A  sample  of  the 
contents  of  an  Exchange  Facility  tape  header  is  shown  in  Table  3. 


1 .  Keywords 

A  "KEYWORD"  is  defined  as  an  attribute  of  the  data,  contained  in  either 
the  tape  header  file  or  the  file  header  record,  which  can  be  used  to  define 
the  portion  of  the  ROSE  DATA  BASE  requested  by  a  user.  The  "keyword"  may  be 
described  by  more  than  one  word  in  the  header  i.e.,  time  is  actually  5  words 
in  the  tape  header,  but  is  a  single  data  attribute  and  thus  a  single 
keyword.  We  have  defined  18  keywords  as  shown  in  Table  4. 
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TABLE  3.  Sample  Contents  of  Exchange  Facility  Tape  Header 


DESCRIPTION 

SAMPLE  CONTENTS 

ROSE  Archive  Tape  Number 

77 

Shot  Line  Number 

SLN6S 

Institution  Rec'd  tape  from 

HIG;  Gettrust 

Documentation  Code;  1=YES 

1 

Data  Archive  Tape  Received 

30  JUL  81 

Data  Archived 

07  AUG  81 

Date  Last  Updated 

20  APR  82 

Date  Last  Accessed 

15  DEC  82 

Instrument  Number 

503 

Event  Numbers 

3134  3241 

Minimum  Data  Start  Time 

1979  2  10  16  59  56 

792 

Maximum  Data  Start  Time 

1979  2  11  02  00  20 

928 

Explosive  Types 

0  0 

Water  Depth  at  Instrument 

2955 

Water  Depths  at  Event 

2523  3122 

Instrument  Depth  (2  way  msec) 

1970 

Event  Depth 

36  73 

Number  of  Channels 

4  4 

Event  Types 

2  2 

Event  Sizes 

2.3  11.3 

Ranges 

2.9  79.5 

Instrument  Latitude 

11.4114 

Instrument  Longitude 

-103.5133 

Event  Latitutde  Range 

11.293  11.392 

Event  Longitude  Range 

-103.504  -104. 

233 
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TABLE  4.  Keywords  and  their  Definitions 


KEYWORD 

DESCRIPTION 

KEYWORD 

DESCRIPTION 

1.  ENUM 

Event  number 

10.  STIME 

Data  start  time 

2.  INUM 

Instrument  I.  D.  no. 

11.  RANGE 

Range-event  to  instrument 

3.  ELAT 

Event  latitude 

12.  ILAT 

Instrument  latitude 

4.  ELON 

Event  longitude 

13.  ILON 

Instrument  longitude 

5.  TYPE 

Event  type 

14.  IDEP 

Instrument  depth 

6.  EDEP 

Event  depth 

15.  WDEPI 

Water  depth  at  instrument 

7.  WDEPE 

Water  depth  at  event 

lb.  CHAN 

Channel  or  component  number 

8.  SIZE 

Event  size 

17.  SHOTLN 

Shotline  designation 

9.  EXPL 

Explosive  type 

18.  TAPE 

Storage  tape  number 

16 


2.  The  Disc  Catalog  format 

The  Catalog  file  is  an  unblocked,  direct  access  area  stored  on  the 
Harris  H-800  disc.  It  contains  most  of  the  information  in  the  event  headers 
of  all  events  stored  in  the  Archive,  and  it  contains  all  the  tape  headers 
describing  the  tapes  in  storage.  The  event  header  information  is  stored  in 
binary  format  and  the  tape  headers  are  ASCII.  The  structure  of  the  file  is 
as  follows: 

(3)  112  word  records,  the  last  of  which  contains  the  address 

of  the  first  tape  header 

(1)  EOF 

(N)  Event  header  records 

(1)  EOF 

(M)  224  word  tape  headers,  each  of  which  contain  the  address  of 

the  first  event  header  record  on  that  tape 

Each  time  tape  headers  and  event  headers  are  added  to  the  Catalog,  the 
starting  position  of  the  header  records  changes.  This  starting  position  is 
updated  and  written  onto  record  3  at  the  time  each  tape  is  archived.  The 
format  for  the  tape  headers  is  shown  in  Table  3.  For  more  efficient  storage 
and  ease  of  manipulation  of  data  attributes  such  as  event  time,  location, 
range  and  size,  the  event  header  information  is  stored  in  the  Catalog  file 
as  shown  in  Table  5. 
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Table  5.  Binary  Event  Records 


Word  #  Variable  Type  Description 


1 

ITYPE 

INT 

2 

TAPENM 

INT 

3 

INUM 

INT 

4 

ENUM 

INT 

5-6 

STIME 

INT*6 

7-8 

SBT 

INT*6 

9-10 

SIZE 

REAL 

11-12 

RANGE 

REAL 

13-14 

HAT 

REAL 

15-16 

ILON 

REAL 

17-18 

ELAT 

REAL 

19-20 

EL  ON 

REAL 

21 

EXPLOS 

INT 

22 

WDEPI 

INT 

23 

WDEPE 

INT 

24 

IDEP 

INT 

25 

EDEP 

INT 

26 

ICHN 

INT 

27 

TYPE 

INT 

28 

RERR 

INT 

29 

ELOER 

INT 

30 

BUB 

INT 

31 

SAMP 

INT 

32 

NWDS 

INT 

33 

FNUM 

INT 

34 

NREC 

INT 

35 

NSAMP 

INT 

36 

IDEL 

INT 

Record  type 

Tape  number 

Instrument  number 

Event  number 

Data  start  time;  c.msec 

Event  time 

Event  size;  kg 

Event  to  instrument  range,  km 
Instrument  latitude 
Instrument  longitude 
Event  latitude 
Event  longitude 
Explosive  type 

Water  depth  at  instrument;  msec 

Water  depth  at  event;  m 

Instrument  depth;  m 

Event  depth;  m 

#  of  channels 

Event  type  code 

Error  estimate  in  range;  m 

Error  radius  in  event  location;  m 

Bubble  pulse  period;  msec 

Sampling  rate;  samp/sec 

Number  of  words/rec  (4096) 

File  number  within  tape 
Number  of  recs /component 
Number  of  samples  in  last  record 
Delete  code;  l=delete 
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3.  Modifications  to  Data  Archived 

Modifications  to  the  event  and  instrument  attributes  are  made  in  the 
computer  Catalog  file  only;  the  original  archived  data  is  not  changed. 

These  modifications  are  incorporated  in  retrieved  data  and  reports,  and  the 
fact  that  it  has  been  modified  is  noted.  Major  errors  are  corrected  by  the 
originating  institution,  which  sends  a  new  tape  to  the  Exchange  Facility. 

B.  Retrieval  and  Exchange 

Special  order  forms  have  been  designed  to  facilitate  processing 
requests  sent  to  the  ROSE  Data  Archive  System.  One  is  the  Shot  Request  Form, 
another  is  the  Earthquake  Request  Form.  Samples  of  these  forms  appear  in 
Appendix  A. 

An  overview  of  the  data  (or  report)  request  handling  and  retrieval 
procedures  follows  (see  flow  chart  in  Figure  3): 

A  request  is  received,  logged  in  and  acknowledged.  Each  request  is 
entered  via  computer  terminal  by  means  of  an  interactive  PASCAL  program 
using  the  archive  language  of  keywords.  The  request  is  then  translated  into 
a  unique  FORTRAN  program  which  handles  searching,  sorting,  merging  and 
reporting.  Entering  and  processing  a  request  is  made  extremely  simple  to 
the  user.  The  search  and  retrieval  programs  were  designed  to  process 
intricate  requests  for  portions  of  the  data  base.  In  practice,  this 
capability  has  not  been  used  to  the  fullest  possible  extent.  Most 
investigators  have  requested  whole  shotlines,  for  example,  and  then  selected 
data  useful  to  them  at  their  own  facilities.  In  addition  to  producing 
FORTRAN  source,  the  initial  program  writes  information  on  the  request  into  a 
storage  area  for  status  reporting  and  prints  a  summary  of  the  request.  The 
request  can  be  processed  at  any  time  by  compiling  the  FORTRAN  source.  The 
result  of  this  is  1)  a  report  of  the  location  (i.e.,  tape  numbers  or  disc 
file  names)  of  requested  data  and  notes  on  any  special  documentation 
available  (ROSE  Archive  Report  #3,  Appendix  A);  and  2)  a  file  of  event 
headers  containing  any  corrections  to  be  incorporated  into  the  data  to  be 
exchanged.  At  this  point,  if  the  request  was  merely  for  a  printed  report  on 
the  amount  of  data  available  which  fit  the  specified  limits,  the  process 
would  be  finished,  except  for  mailing  the  report.  The  usual  request  will  be 
for  the  data  itself,  and  in  this  case  the  next  step  is  the  actual  retrieval. 
Using  the  list  of  tape  and  file  numbers,  a  data  technician  will  read  in  the 
data,  merge  updated  event  headers  with  the  data,  sort  it  into  the  requested 
order  and  write  it  out  in  ROSE  format  with  a  tape  header  file  describing  the 
tape  contents.  After  being  verified,  the  tape  or  tapes  will  be  logged  and 
then  sent  to  the  requesting  participant  along  with  available  documentation 
and  a  summary  report  of  the  data. 

Bi-annual  bulletins  are  sent  to  participants  in  the  ROSE  experiment  to 
keep  them  appraised  of  data  availability  at  the  archive.  A  sample  bulletin 
is  contained  in  Appendix  B. 


IV.  Computer  Hardware  and  Software  for  the  Archive 
A.  Hardware 

The  ROSE  Data  Archive  uses  the  H.I.G.  computer  facility  which  also 
serves  as  the  primary  scientific  computer  system  for  faculty,  researchers 
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Request  Handling  and  Data  Retrieval 


Log  date 
originator, 
etc 


J- 


LOG 

book 


i 


ACKNOWLEDGE 

RECEIPT 


I 


TRANSLATE 
-1  REQUEST  TO 
KEYWORD  BOUNDS 

J 


I 


1 


ENTER  INTO 
REQUEST  STATUS 
AREA  FOR 
REPORTING 


^TRANSLATE  t 
K"-TQ  FORTRAN- | 
=.  SUBROUTINE^1 


I  REQUEST 
SUMMARY  REPORT 
[based  on  input  - 1  copy  filed 

I  copy  sent  w/data 


T 


Figure  3 


Flow  chart  of  the  procedures  for  the  retrieval  of 
digital  seismic  data. 
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and  students  associated  with  the  Institute.  The  facility's  equipment  is 
based  on  a  Harris  H800  computer  with  virtual  memory  access,  with  448k  words 
of  MOS  memory  and  three  300  Megabyte  disc  modules.  See  Appendix  C  for  a 
complete  list  of  peripherals  and  software.  The  ROSE  Archive  is  but  one  of  a 
number  of  "users”  of  the  computer  system  where  64  terminals  and  15 
background  programs  compete  for  system  resources.  To  minimize  the  impact  of 
Archive  data  handling  in  such  a  competitive  system,  the  computer  programs 
for  the  Archive  were  written  to  be  input-output  (I/O)  limited.  This  has 
turned  out  to  be  reasonably  simple  since  the  combination  of  PASCAL  and 
Fortran  77  languages  allows  us  to  generate  very  efficient  code  for  all  the 
tasks  which  are  a  part  of  the  Archive*  Due  to  the  multiple,  independent  I/O 
channel  design  of  the  Harris  computer  system  and  efficient  programming,  the 
impact  on  research  computing  has  been  minimal.  In  fact,  the  additional  disc 
storage  unit  and  two  magnetic  tape  drives  purchased  for  the  ROSE  Archive 
benefit  research  projects  when  the  Archive  does  not  require  their  use. 

B.  Software 

The  following  is  a  list  of  program  names  and  descriptions  of  their 
function.  Program  listings  and  examples  of  input  and  output  appear  in 
Appendix  D. 


Source  Name 

DISTAP 


DVIEW 


RECLEN 


BIARCH 


BHIROS 


DISCAT 

LISHDR 


RDHDR 

FIX 


Programs  Used  By  ROSE  Archive  &  Retrieval  System 

_  Descr  iption/F.unction _ 

-Initial  check  of  incoming  archive  tapes  reads  and 
displays  to  screen  archive  tape  header  and  event  headers 

-Can  also  display  an  HIG  archived  tape,  i.e.,  with  an  HIG 
header. 

-Displays  first  50  data  values  of  N  records  on  an  incoming 
tape . 

-Reads  incoming  (or  any)  tape  and  prints  record  lengths 
and  event  numbers. 

-Reads  incoming  tape,  adds  info  to  Catalog,  builds  HIG 

archive  header,  archives  to  new  tape.  Auxiliary  programs: 

M<BIARC,  HEDGEN,  TAPOS. 

-Same  as  BIARCH  for  data  in  the  format  used  internally  at 
HIG.  Auxiliary:  HRAMAC,  ROSEHD,  HEDGEN,  TAPOS. 

-Display  Catalog  tape  headers  and/or  file  header  records. 

-List  the  Catalog  tape  headers  either  by  tape  or 
instrument. 

-List  Catalog  event  headers. 

-Edit  Catalog  event  headers. 


ROSED 
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-Edit  Catalog  tape  headers. 

ADHED,  ADTAPE,  -  Add  and/or  delete  Catalog  records. 
DELHDR,  DELTAP 

BULLETIN 

SEARCH 


RETREV 


RARHIG 


ITMCNT 


V.  Summary 

The  ROSE  participants  have  gathered  a  large,  unique  marine  and  land 
seismic  database  which,  by  prior  agreements,  is  being  shared  through  a  data 
storage  and  exchange  facility  located  at  the  Hawaii  Institute  of  Geophysics. 
The  data  are  available  to  all  participants  and  to  the  entire  scientific 
community.  After  1983,  these  data  will  be  available  from  National 
Geophysical  Data  Center,  Boulder,  Colorado.  The  combination  of  an  easily 
read  data  exchange  medium  and  effective  cataloging  system  has  made  the  ROSE 
Data  Exchange  Facility  viable. 

The  ROSE  project  represents  one  of  the  new  types  of  data  intensive 
marine  programs  that  will  be  pursued  and  extended  in  the  future.  It  is 
anticipated  that  the  formats  developed  for  this  experiment  will  be  the 
standard  for  storing  and  exchanging  marine  refraction  data. 
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-Generate  "Bulletin"  from  Catalog  after  sorting. 

-Search  Catalog  for  storage  tape  location  of  specified 
instruments,  events,  times,  positions,  etc.  Auxiliary 
programs  RECSEL,  SELECT,  M<SEARCH. 

-Retrieve  specified  data  from  archive  tapes.  Auxiliary 
program  M<RETREV. 

-Convert  data  in  ROSE  Archive  format  to  internal  HIG 
format. 

-Time  conversion  subroutine  used  in  all  programs.  Entry 
points  CNTITM,  ULCNT. 
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FORM  #1 

<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>:>>>>>>>>>>>>>>> 

SEND  TO:  SHARON  LATRAILLE,  ROSE  ARCHIVE 
ROSE  DATA  ARCHIVE  SHOT  REQUEST  FORM  HAWAII  INSTITUTE  OF  GEOPHYSICS 

2525  CORREA  ROAD 
HONOLULU,  HAWAII  96822 

PLEASE  STATE  AS  CONCISELY  AS  POSSIBLE  WHAT  REPORT  IS  TO  BE  GENERATED  OR  WHAT 
DATA  IS  TO  BE  RETRIEVED _ . _  ■  _ : _ 


PLEASE  DESCRIBE  YOUR  REQUEST  IN  DETAIL  BY  CHECKING  OR  FILLING  IN  THE 
FOLLOWING  SHOT  AND  INSTRUMENT  DESCRIPTORS.  CHECK  THE  "ALL"  BOX  TO  INDICATE 
YOU  WANT  ALL  SHOT /INSTRUMENTS  PAIRS  WITH  THAT  CHARACTERISTIC. 

_ _ REPORT  ONLY 

_ REPORT  AND  DATA  RETRIEVAL 

9  TRACK  TAPE  PARAMETERS: 

DENSITY:  800  (  )  OR  1600  (  )  BPI 

FORMAT:  ASCII(  )  OR  EBCDIC  (  ) 

FOR  EACH  DATA  REQUEST  YOU  WILL  RECIEVE  A  LISTING  DESCRIBING  THE  DATA  BEING 
SENT,  ANY  DOCUMENTATION  AVAILABLE  ON  THE  INSTRUMENTS  INVOLVED,  AND  THE  DATA 
ITSELF  IN  ROSE  FORMAT  ON  9  TRACK  TAPE. 


**************************************************************************** 
SHOT  DESCRIPTORS 

SHOT  NUMBERS:  ALL  (  ) ,  OR  SPECIFY  # S _ _ 

SHOT  TYPE:  ALL  (  ) ,  OR  SPECIFY  TYPE  # S _ 

l)TOVEX,  2)DYNAMITE,  3)TETRATOL,  4)SUS,  5)MAXIPULSE,  6)AIRGUN,  7 )TNT, 

8) OPEN,  9) OTHER 

SHOT  LINES:  ALL  (  ) ,  OR  SPECIFY  LINE  #S  _ . _ 

TIME  WINDOW:  ALL  (  )  ,  OR  SPECIFY  FROM . .  Z  TO _ Z 

SHOT  SIZE:  ALL  (  ) ,  OR  SPECIFY  SIZE  BOUNDS(LBS) _ _ 

LOCATION:  ALL(  ),  OR  SPECIFY  FROM  LATITUDE  _  TO  LATITUDE  _ 

AND  FROM  LONGITUDE _ _TO  LONGITUDE . . 

WATER  DEPTH:  ALL(  ),  OR  SPECIFY  DEPTH  BOUNDS(M) _ 

SHOT  DEPTH:  ALL(  ),  OR  SPECIFY  DEPTH  BOUNDS(M) _ _ , _ 

RANGE,  EVENT  TO  INSTRUMENT:  ALL(  ),  OR  SPECIFY  BOUNDS (KM) _ 
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INSTRUMENT  DESCRIPTORS 


I.D.  NUMBER:  ALL(  ),  OR  SPECIFY  NUMBERS, _ _ _ 

LAND  VERSUS  SEA  STATION:  ALL(  ),  OR  CHECK  ONE:  OCEANIC(  )  CONTINENTAL(  ) 

LOCATION:  ALL(  ),  OR  SPECIFY  FROM  LATITUDE _ TO  LATITUDE 

.  .  AND  FROM  LONGITUDE  . _ _ _ ;TO  LONGITUDE _ 

INSTRUMENT  DEPTH:  ALL(  ),  OR  SPECIFY  BOUNDS (M)  _ _ 

WATER  DEPTH:  ALL(  ),  OR  SPECIFY  BOUNDS  (MSEC )_. _ ...... _ _ 

COMPONENT  (CHANNEL)  #S :  ALL(  ),  OR  SPECIFY  CODE  #S_ _ 

1) VERTICAL.  2) RADIAL.  3.) TANGENTIAL.  A ) HYDROPHONE ,  .5 ) NON-.ROTATEE  FIRST 

_ HORIZONTAL.  6 ) NON- ROTATED  SECOND  HORIZONTAL,  .7  )  WATER  WAVE,  8).IIME 


27 


FORM  #2 

«<<«<<««««««««««««««««<>»»»»»»»»»»»»»>»»»> 

SEND  TO: 

SHARON  LATRAILLE,  ROSE  ARCHIVE 
ROSE  DATA  ARCHIVE  EARTHQUAKE  REQUEST  FORM  HAWAII  INSTITUTE  OF  GEOPHYSICS 

2525  CORREA  ROAD 
HONOLULU,  HAWAII  96822 

Please  state  as  concisely  as  possible  what  report  is  to  be  generated  or  what 
data  is  to  be  retrieved  _  _ • _ ; _ 


Please  describe  your  request  in  detail  by  checking  or  filling  in  the 
following  earthquake  and  instrument  descriptors.  Check  the  All  box  to 
indicate  you  want  all  earthquake/instrument  pairs  with  that  characteristic. 

_  Report  only 

_ .  Report  and  data  retrieval 

9  track  tape  parameters: 

Density:  800  (  )  or  1600  (  )  BPI 

Format  :  ASCII(  )  or  EBCDIC(  ) 

For  each  data  request  you  will  receive  a  listing  describing  the  data  being 
sent,  any  documentation  available  on  the  instruments  involved,  and  the  data 
itself  in  ROSE  format  on  9  track  tape. 

****************************** ********************************************** 
EARTHQUAKE  DESCRIPTORS 

Earthquake  #s :  ALL(  ),  OR  SPECIFY  CATALOG  #S _ 

Recording  time  window:  ALL(  ),  OR  SPECIFIY  FROM _ Z  TO 

_ Z 


Magnitude:  ALL(  )  OR  SPECIFY  BOUNDS _ . _ ■  _ 

location:  ALL(  )  OR  SPECIFY  FROM  LATITUDE  .  . _ TO  LATITUDE _ 

_ AND  FROM  LONGITUDE _ . _ . _ TO  LONGITUDE _ 

Land  versus  sea:  ALL(  ),  OR  CHECK  ONE:  OCEANIC  (  )  CONTINENTAL  (  ) 

Limit  in  location  error:  ALL(  ),  OR  SPECIFY  ERROR  RADIUS  BOUNDS(M) _ 

Source  depth:  ALL(  ),  OR  SPECIFY  DEPTH  BOUNDS (KM) _ 

Range,  event  to  instrument:  ALL(  ),  OR  SPECIFY  BOUNDS(KM)  .  _ 

INSTRUMENT  DESCRIPTORS 

I.D.  Number:  ALL(  ),  OR  SPECIFY  NUMBERS _ .  _ 


Land  versus  sea  station:  ALL(  ),  OR  CHECK  ONE:  OCEANIC(  )  CONTINENTAL  (  ) 
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Location:  All(  ),  OR  SPECIFY  FROM  LATITUDE _ TO  LATITUDE _ 

AND  FROM  LONGITUDE _ _ _ TO  LONGITUDE  _ 

Instrument  Depth:  ALL(  ),  OR  SPECIFY  BOUNDS(M) _ _ _ 

Water  depth:  ALL(  ).  OR  SPECIFY  BOUNDS(MSEC) _  ■  _ t _ 

Component  (Channel)  #S :  ALL(  ).  OR  SPECIFY  CODE  #S _ 

l)Vertical,  2)Radial,  3)Tangential ,  4)Hydrophone ,  5 )Non-rotated  first 

horizontal,  6)Non-rotated  second  horizontal,  7)Water  wave,  8)Time 

\ 

SEND  REPORT  AND/OR  DATA  TO:  _ 
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FORM  #3 

«<<<<«««««««<««««««««<«>>»»>>»>>»>»»>»»»»>>»>>>> 

SELECT  PROGRAM  INPUT  FORM 


1.  INSTRUMENT  # 

(INUM) 

10.  EXPLOSIVE  TYPE 

( 1=TQVEX.  2=DYN,.3=TET) 

(EXPLOS) 

(4=SUS,5=MAXI,6=AG) 

(7=TNT,9=OTHER) 

2.  EVENT  # 

(ENUM) 

11.  WATER  DEPTH  (?  INST. 
(ONE-WAY  MSEC) 

(WDEPI ) 

3.  DATA  START  TIME 
(YR,MO, DA, 

HR, MIN, SEC) 

USE  COMMAS 

(STIME) 

12.  WATER  DEPTH  AT  EVENT  (WDEPE) 
(METERS) 

4.  EVENT  SIZE 

(SIZE) 

13.  COMPONENT  TYPE 

(CHAN) 

(SHOTS: KG; QUAKES 

l 

( 1 =VERT , 2=RAD , 3 =TANG ) 

10*MAGNITUDE  OR 

4=HYDRO, 5=1  ST  HORIZ) 

CODA  LENGTH, SEC*10) 

(6=2ND  HOR,  7=WW, 8=TIME) 

5.  RANGE  (KM) 

(RANGE) 

14.  EVENT  DEPTH 
(METERS) 

(EDEP) 

6.  INST.  LATITUDE 

( ILAT ) 

15.  INST.  DEPTH 
.(METERS) 

( IDEP ) 

7.  INST.  LONGITUDE 

(ILON) 

16.  EVENT  TYPE 
(l=OUAKE.2=SHOT) 

(TYPE) 

8.  EVENT  LATITUDE 

(ELAT) 

17.  SHOTLINE 

(LIKE  1S,3L,1T3) 

( SHOTLN) 

9.  EVENT  LONGITUDE 

(ELON) 

18.  ARCHIVE  TAPE  NO. 

(TAPENM) 

(4  DIGITS) 


VALID  LOGICAL  SYMBOLS:  /-TO,  =- EQUALS, 

C-LESS  THAN,  > -GREATER  THAN, 

-NOT  EQUAL,  BLANK-AND 

Example:  ENUM  505/510  means  event  #s  505  to  510 
RANGE  >500  means  range  greater  than  500 
TYPE  1  2  means  type  1  and  2 

Type  SELECT  and  then  enter  the  select  input  information  from  this  form  using 
logical  symbols,  if  needed.  Enter  1  or  more  lines.  To  stop  entering,  type 
END  and  2  carraige  returns.  List  RECSEL  and  check  to  see  if  it  is  correct. 
Then  type  SEARCH  and  the  following  will  happen: 

a)  Subroutine  will  be  compiled 

b)  Program  will  be  vulcanized 

c)  Catalog  will  be  searched 
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ROSE  ARCHIVE  REPORT  #1 


*  *  *  SUMMARY  OF  DATA  ARCHIVED  *  *  *  RUN  DATE,  TIME 

21  MAY  80,  11:11:43 

RARC  TAPE  #  17  DATE  RECEIVED:  19  MAY  80  EXPERIMENT:  ROSE  I 

TAPE  DATA  START  TIME:  79  2  3  21  00 

TAPE  DATA  END  TIME  :  79  2  4  8  00 


INSTRUMENT  #:  503 

DOCUMENTATION  CODE  (YES=1):  1 
COMPONENTS  1-10  ONLY:  HIP  TIV 
INSTRUMENT  DEPTH:  3096  M. 
NUMBER  OF  EVENTS:  35 


DESIGNER:  HIG  ENGR. ,  HAWAII  INST  GEOPHYSICS 
INSTITUTION  RECEIVED  FROM:  H.I.G. ;  GETTRUST 
INSTRUMENT  LAT,LON :  11.8339,-102.7839 
WATER  DEPTH  AT  INSTRUMENT:  2064  MSEC. 


KEYWORD  MINIMUM  &  MAXIMUM  VALUES: 


EVENT  TYPE  2 
EVENT  #S 

DATA  START  TIMES  1979  2 

EVENT  LATITUDES 
EVENT  LONGITUDES 
EVENT  DEPTHS 
WATER  DEPTHS 
EVENT  SIZES 
EXPLOSIVE  TYPE 
RANGES-EVENT  TO  RCVR 


SHOT  LINE  #:  SLN3L 


1007 

TO 

1041 

20  59 

TO 

1979 

2 

11.027 

TO 

12. 

943 

-102.587 

TO 

-102. 

913 

57 

TO 

132 

M 

2790 

TO 

3168 

M 

87.1 

TO 

232.2 

KG 

1 

10.1 

TO 

124.1 

KM 

59 
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ROSE  ARCHIVE  REPORT  #2 


ROSE  ARCHIVE  TAPE  NO. 

SHOT  LINE  NO. 

INSTITUTION  RECD  TAPE  FROM 
DOCUMENTATION  CODE;  1=YES 
DATE  ARCHIVE  TAPE  RECEIVED 
DATE  ARCHIVED 
DATE  LAST  UPDATED 
DATE  LAST  ACCESSED 

*******************mxNIMUM  &  MAXIMUM  VALUES  OF 

INSTRUMENT  NUMBER 

EVENT  NUMBERS 

MINIMUM  DATA  START  TIME 

MAXIMUM  DATA  START  TIME 

EXPLOSIVE  TYPES 

WATER  DEPTH  AT  INSTRUMENT 

WATER  DEPTHS  AT  EVENT 

INSTRUMENT  DEPTH 

EVENT  DEPTHS 

#S  OF  CHANNELS 

EVENTS  TYPES 

EVENT  SIZES 

RANGES 

INSTRUMENT  LATITUDE 

INSTRUMENT  LONGITUDE 

EVENT  LATITUDE  RANGE 

EVENT  LONGITUDE  RANGE 

*****  TAPE  HEADER  FILE  CONTENTS  ***** 

INSTR.  #  1001  DESIGNER  NUSC  NEW  LONDON 

EXPERIMENT:  ROSEjMABS  #  OF  EVENTS: 

TAPE  DATA  START  TIME 
TAPE  DATA  END  TIME 


1 

SLNlT 

MASS.  INSTITUTE  OF  TECHNOLOGY 
1 

26  FEB  80 
5  MAR  80 
5  MAR  80 
5  MAR  80 

KEYWORDS  ********************* 
1001 

1001  5002 

1979  2  2  2  0  0  0 

1979  2  2  11  59  50  0 

1  1 
676 

2970  6715 

1014 

100  133 

12  12 
2  2 

816.5826 
39.8110 
12.2400 
-101.9570 
10.3470 


907 .8208 
347 .3430 


14.0050 


-101.2880  -104.6060 

LAB  NEW  LONDON,  CONN  06320 
11 

1979  2  2  2  0  0  0 

1979  2  2  12  0  0  0 
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ROSE  ARCHIVE  REPORT  #3 


*  *  *  DATA  RETRIEVAL  REQUEST  *  *  * 

REQUEST  RECEIVED:  9/5/79 
REQUESTING  PARTY:  J.  GETTRUST,  HIG 


REQUEST  KEYWORD  BOUNDS  (KEYWORD  BOUNDS="ALL"  NOT  LISTED) 


INSTRUMENT  NUMBERS: 

514  ' 

TO 

516 

EVENT 

NUMBERS: 

4050 

TO 

4555 

EVENT 

TYPE: 

2 

EVENT 

SIZES 

30 

TO 

200 

COMPONENTS : 

V  P 

DATA  LIST 

RARC 

TAPE 

NUMBER 

INSTRUMENT 

EVENTS 

29 

514 

4050 

-  4128 

30 

514 

4129 

-  4320 

31 

514 

4321 

-  4440 

32 

514 

4441 

-  4555 

40 

515 

4200 

-  4320 

41 

515 

4321 

-  4420 

42 

515 

4421 

-  4555 

55 

516 

4495 

-  4555 
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ROSE  ARCHIVE  REPORT  #4 

*  *  *  SUMMARY  OF  DATA  RETRIEVED  *  *  * 


REQUEST  RECEIVED:  9/9/79 
REQUESTING  PAETY:  JOE  GETTRUST 


REQUEST  KEYWORD  BOUNDS  (KEYWORDS  BOUNDS="ALL"  NOT  LISTED) 


INSTRUMENT  NUMBERS: 
EVENT  NUMBERS: 

EVENT  SIZE: 
COMPONENTS : 


511  TO  514 
4098  TO  4138 
2 

200  TO  5000 


DATA  RETRIEVED  (IN  THE  ORDER  ON  THE  TAPE) 


TAPE  NUMBER  1 


INSTRUMENT  # 

EVENT  # 

TYPE 

SIZE(KG) 

LATITUDE 

LONGITUDE 

COMPONENTS 

511 

409  8 

2 

816.47 

12.4918 

-100.9702 

V  P 

511 

4099 

2 

816.47 

12.5039 

-101.2876 

V  P 

511 

4100 

2 

816.47 

12.3212 

-101.6007 

V  P 

511 

41 28 

2 

81.65 

11.9644 

-101.8834 

V  P 

511 

4129 

2 

81.65 

11.9249 

-101.8747 

V  P 

511 

4130 

2 

81.65 

11.8856 

-101.8661 

V  P 

511 

4131 

2 

81.65 

11.8463 

-101.8578 

V  P 

511 

4132 

2 

81.65 

11.8072 

-101.8499 

V  P 

511 

4133 

2 

217.73 

11.7695 

-101.8420 

V  P 

511 

4134 

2 

217.73 

11.6914 

-101.8251 

V  P 

511 

4135 

2 

217  .73 

11.6138 

-101.8086 

V  P 

511 

4136 

2 

217.73 

11.5363 

-101.7921 

V  P 

511 

4137 

2 

217.73 

11.4585 

-101.7752 

V  P 

511 

4138 

2 

217.73 

11.3811 

-101.7589 

V  P 

512 

409  8 

2 

816.47 

12.4918 

-100.9702 

V  P 

512 

4099 

2 

816.47 

12.5039 

-101.287  6 

V  P 

512 

4100 

2 

816.47 

12.3212 

-101.6007 

V  P 

512 

4101 

2 

816.47 

13.4234 

-102.1361 

V  P 

512 

4102 

2 

816.47 

13.7728 

-102.2160 

V  P 

512 

4103 

2 

816.47 

14.0833 

-102.2561 

V  P 

512 

4128 

2 

81.65 

11.9644 

-101.8834 

V  P 

512 

4129 

2 

81.65 

11.9249 

-101.8747 

V  P 

512 

4130 

2 

81.65 

11.8856 

-101.8661 

V  P 

512 

4131 

2 

81.65 

11.8463 

-101.8578 

V  P 

512 

4132 

2 

81.65 

11.8072 

-101.8499 

V  P 

512 

4133 

2 

217.73 

11.7695 

-101.8420 

V  P 

512 

4134 

2 

217  .73 

11.6914 

-101.8251 

V  P 

512 

4135 

2 

217  .73 

11.6138 

-101.8086 

V  P 

512 

4136 

2 

217.73 

11.5363 

-101.7921 

V  P 

512 

4137 

2 

217.73 

11.4585 

-101.7752 

V  P 

512 

4138 

2 

217.73 

11.3811 

-101.7  589 

V  P 
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************************************************************************ 

************************************************************************ 

************************************************************************ 

************************************************************************ 

************************************************************************ 


****** 

******* 

******* 

******** 

******** 

********* 
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**** 
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*  * 

*  * 

* 

* 

*  * 
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Archive  Status  Report 
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Since  the  December  1981  edition  of  the  Archive  Status 
Bulletin,  the  volume  of  data  sent  to  the  storage  facility  has 
leveled  off.  Most  of  the  Phase  I  shot  data  is  now  on  archive 
tapes.  Oregon  State  University  added  over  2000  Phase  I  shots 
early  this  year.  The  ROSE  data  storage  and  exchange  facility  now 
houses  about  21,600  events  (event-instrument  pairs)  ,  with  eight 
participating  institutions  represented.  They  are  Hawaii  Institute 
of  Geophysics,  Oregon  State  University,  Scripps  Institute  of 
Oceanography,  Woods  Hole  Oceanographic  Institute,  Massachusetts 
Institute  of  Technology,  University  of  Texas  Marine  Science 
Institute,  University  of  California  at  Santa  Barbara  and 
University  of  Washington.  The  data  from  Lamont-Doherty  Geological 
Observatory  is  expected  this  summer.  A  listing  of  the  data 
contained  in  the  Archive,  including  earthquake  data,  is  attached 
along  with  a  summary  of  the  events  for  each  participating 
institution. 

Several  large  requests  for  data  have  been  processed  since  the 
last  report*  Request  handling  has  been  the  main  activity;  our 
retrieval  procedures  have  smoothed  out  considerably  so  that  time 
to  process  a  request  now  averages  one  week. 

An  article  entitled  "The  ROSE  Seismic  Data  Storage  and 
Exchange  Facility,  which  details  the  development  of  the  facility 
and  the  exchange  format,  describes  the  procedures  for  archiving 
and  gives  examples  of  the  capability  and  use  of  data  retrieval,  is 
now  in  press  at  the  Journal  of  Geophysical  Research  and  should  be 
published  this  year. 
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PHASE  1  EVENTS 


SHOTLINE  DESIGNATION:  SLN1AG 


Num  Instrument  Beginning  and  Ending 

Evnts  I.D.  (Origin)  Data  Start  Times 


351 

1  WHOI 

1979 

1/31 

3 

37 

to 

1/31 

8:48 

548 

2  WHOI 

1979 

1/30 

23 

38 

to 

1/31 

7:55 

436 

5  WHOI 

1979 

1/30 

15 

1 

to 

1/30 

21:15 

423 

6  WHOI 

1979 

1/30 

11 

57 

to 

1/30 

17:57 

222 

7  WHOI 

1979 

1/30 

11 

2 

to 

1/30 

14:13 

248 

8  WHOI 

1979 

1/30 

11 

2 

to 

1/30 

14:30 

Subtotal  2228 


SHOTLINE  DESIGNATION:  SLNlL 


Num 

Instrument 

Beginning 

and 

Ending 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

29 

1 

WHOI 

1979 

2/ 

3 

6:  0 

to 

2/ 

3 

19:30 

28 

2 

WHOI 

1979 

2/ 

3 

6:  0 

to 

2/ 

3 

19:30 

25 

6 

WHOI 

1979 

2/ 

3 

8:30 

to 

2/ 

3 

19:30 

16 

7 

WHOI 

1979 

2/ 

3 

11:59 

to 

2/ 

3 

19:30 

17 

8 

WHOI 

1979 

2/ 

3 

11:  0 

to 

2/ 

3 

19:30 

18 

204 

UTMSI 

1979 

2/ 

3 

10:59 

to 

2/ 

3 

19:29 

19 

205 

UTMSI 

1979 

2/ 

3 

9:59 

to 

2/ 

3 

19:29 

26 

207 

UTMSI 

1979 

2/ 

3 

6:29 

to 

2/ 

3 

19:29 

24 

208 

UTMSI 

1979 

2/ 

3 

7:59 

to 

2/ 

4 

8:59 

20 

209 

UTMSI 

1979 

2/ 

3 

9:59 

to 

2/ 

3 

19:29 

18 

210 

UTMSI 

1979 

2/ 

3 

9:59 

to 

2/ 

3 

19:29 

13 

211 

UTMSI 

1979 

2/ 

3 

5:59 

to 

2/ 

3 

14:59 

15 

212 

UTMSI 

1979 

2/ 

3 

6:  0 

to 

2/ 

3 

14:59 

18 

213 

UTMSI 

1979 

2/ 

3 

5:59 

to 

2/ 

3 

14:59 

20 

302 

SCRIPPS 

1979 

2/ 

3 

5:59 

to 

2/ 

3 

16:29 

28 

303 

SCRIPPS 

1979 

2/ 

3 

5:59 

to 

2/ 

3 

19:29 

29 

402 

uw 

1979 

2/ 

3 

6:  0 

to 

2/ 

3 

19:30 

29 

403 

uw 

1979 

2/ 

3 

6:  0 

to 

2/ 

3 

19:30 

28 

405 

uw 

1979 

2/ 

3 

6:  0 

to 

2/ 

3 

19:30 

28 

407 

uw 

1979 

2/ 

3 

6:  0 

to 

2/ 

3 

19:30 

16 

501 

HIG 

1979 

2/ 

3 

11:59 

to 

2/ 

3 

19:30 

42 


5006 

to 

5035 

29 

506  HIG 

1979 

2/ 

3 

6:  0 

to 

2/ 

3 

19:30 

5006 

to 

5035 

29 

509  HIG 

1979 

2/ 

3 

6:  0 

to 

2/ 

3 

19:30 

5006 

to 

5035 

29 

510  HIG 

1979 

2/ 

3 

6:  0 

to 

2/ 

3 

19:30 

5010 

to 

5016 

7 

701  MIT 

1979 

2/ 

3 

8:  0 

to 

2/ 

3 

10:  0 

5006 

to 

5022 

32 

1001  MIT 

1979 

2/ 

3 

6:  0 

to 

2/ 

3 

12:59 

5023 

to 

5035 

13 

1001  MIT 

1979 

21 

3 

13:29 

to 

2/ 

3 

19:30 

Subtotal  603 


SHOTLINE  DESIGNATION:  SLN1S 

Event  #s  Num  Instrument  Beginning  and  Ending 


Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Timei 

5 

1049 

to 

1167 

104 

2 

WHOI 

1979 

2/ 

5 

1:35 

to 

2/ 

5 

11:25 

1168 

to 

1295 

113 

2 

WHOI 

1979 

2/ 

5 

11:30 

to 

2/ 

5 

22:  5 

1175 

to 

1377 

17  8 

5 

WHOI 

1979 

2/ 

5 

12:  5 

to 

2/ 

6 

4:55 

1216 

to 

1377 

146 

6 

WHOI 

1979 

2/ 

5 

15:30 

to 

2/ 

6 

4:55 

1263 

to 

1377 

99 

7 

WHOI 

1979 

2/ 

5 

19:25 

to 

2/ 

6 

4:55 

1253 

to 

1377 

107 

8 

WHOI 

1979 

2/ 

5 

18:35 

to 

2/ 

6 

4:55 

1084 

to 

1324 

20 

205 

UTMSI 

1979 

2/ 

5 

4:29 

to 

2/ 

6 

0:29 

1144 

to 

1318 

37 

207 

UTMSI 

1979 

2/ 

5 

9:29 

to 

2/ 

6 

23:59 

1042 

to 

1162 

13 

211 

UTMSI 

1979 

2/ 

5 

0:59 

to 

21 

5 

10:59 

1042 

to 

1144 

18 

212 

UTMSI 

1979 

2/ 

5 

0:59 

to 

2/ 

5 

9:29 

1042 

to 

1054 

66 

302 

SCRIPPS 

1979 

2/ 

5 

0:59 

to 

3/21 

0:43 

1042 

to 

1342 

72 

303 

SCRIPPS 

1979 

2/ 

5 

0:59 

to 

2/ 

6 

1:59 

1042 

to 

1202 

160 

402 

UW 

1979 

2/ 

5 

1:  0 

to 

2/ 

5 

14:20 

1203 

to 

1284 

80 

402 

UW 

1979 

2/ 

5 

14:25 

to 

2/ 

5 

21:10 

1042 

to 

1202 

160 

403 

UW 

1979 

2/ 

5 

1:  0 

to 

2/ 

5 

14:20 

1203 

to 

1284 

80 

403 

UW 

1979 

2/ 

5 

14:25 

to 

2/ 

5 

21:10 

1042 

to 

1202 

160 

405 

UW 

1979 

2/ 

5 

1:  0 

to 

2/ 

5 

14:20 

1203 

to 

1284 

80 

405 

UW 

1979 

2/ 

5 

14:25 

to 

2/ 

5 

21:10 

1042 

to 

1202 

139 

406 

UW 

1979 

2/ 

5 

1:  0 

to 

2/ 

5 

14:20 

1203 

to 

1284 

68 

406 

UW 

1979 

2/ 

5 

14:25 

to 

2/ 

5 

21:10 

1042 

to 

1202 

160 

407 

UW 

1979 

2/ 

5 

1:  0 

to 

2/ 

5 

14:20 

1207 

to 

1287 

80 

407 

UW 

1979 

2/ 

5 

14:45 

to 

2/ 

5 

21:25 

1042 

to 

1378 

335 

501 

HIG 

1979 

2/ 

5 

0:59 

to 

2/ 

6 

4:59 

1090 

to 

1378 

287 

506 

HIG 

1979 

2/ 

5 

5:  0 

to 

2/ 

6 

4:59 

1042 

to 

1376 

329 

507 

HIG 

1979 

2/ 

5 

0:59 

to 

2/ 

6 

4:49 

1081 

to 

1150 

70 

509 

HIG 

1979 

2/ 

5 

4:15 

to 

2/ 

5 

10:  0 

1153 

to 

1262 

110 

509 

HIG 

1979 

2/ 

5 

10:15 

to 

2/ 

5 

19:20 

1263 

to 

1378 

115 

509 

HIG 

1979 

2/ 

5 

19:24 

to 

2/ 

6 

5:  0 

1043 

to 

1243 

200 

510 

HIG 

1979 

2/ 

5 

1:  4 

to 

2/ 

5 

17:44 

1244 

to 

1378 

134 

510 

HIG 

1979 

2/ 

5 

19:50 

to 

2/ 

6 

5:00 

Subtotal  3720 


SHOTLINE  DESIGNATION:  SLNlTl 


Event  #s  Num  Instrument  Beginning  and  Ending 

Included  Evnts  I.D.  (Origin)  Data  Start  Times 


3011 

to 

3012 

2 

1 

WHOI 

1979 

2/ 

2 

19:  0 

to 

2/ 

2 

21:  0 

3011 

to 

3012 

2 

2 

WH0I 

1979 

2/ 

2 

19:  0 

to 

2/ 

2 

21:  0 

4099 

to 

4100 

2 

6 

WHOI 

1979 

2/ 

2 

2:  0 

to 

2/ 

2 

4:  3 

4099 

to 

4100 

2 

7 

WHOI 

1979 

2/ 

2 

2:  0 

to 

2/ 

2 

4:  3 

4099 

to 

4100 

2 

8 

WHOI 

1979 

2/ 

2 

2:  0 

to 

2/ 

2 

4:  3 

4098 

to 

4099 

2 

207 

UTMSI 

1979 

2/ 

1 

23:59 

to 

2/ 

2 

1:59 

3011 

to 

3013 

3 

211 

UTMSI 

1979 

2/ 

2 

18:59 

to 

2/ 

2 

22:59 

3011 

to 

3013 

3 

212 

UTMSI 

1979 

2/ 

2 

18:59 

to 

2/ 

2 

22:59 

4098 

to 

4151 

6 

303 

SCRIPPS 

1979 

2/ 

2 

1:59 

to 

2/ 

6 

5:59 

4098 

to 

3013 

6 

402 

UW 

1979 

2/ 

2 

0:  0 

to 

2/ 

2 

22:59 

4098 

to 

3013 

6 

403 

UW 

1979 

2/ 

2 

0:  0 

to 

2/ 

2 

22:59 

4098 

to 

3013 

6 

405 

UW 

1979 

2/ 

2 

0:  0 

to 

2/ 

2 

22:59 

4098 

to 

3013 

6 

407 

UW 

1979 

2/ 

2 

0:  0 

to 

2/ 

2 

22:59 

4098 

to 

3013 

6 

502 

HIG 

1979 

2/ 

1 

23:59 

to 

2/ 

2 

22:59 

4098 

to 

3013 

6 

503 

HIG 

1979 

2/ 

1 

23:59 

to 

2/ 

2 

23:01 

4098 

to 

3013 

6 

504 

HIG 

1979 

2/ 

1 

23:59 

to 

2/ 

2 

22:59 

4098 

to 

3013 

6 

506 

HIG 

1979 

2/ 

1 

23:59 

to 

2/ 

2 

22:59 

4099 

to 

3013 

4 

507 

HIG 

1979 

2/ 

2 

1:59 

to 

2/ 

2 

22:59 

4099 

to 

3013 

5 

509 

HIG 

1979 

2/ 

2 

1:59 

to 

2/ 

2 

22:59 

4099 

to 

3013 

5 

510 

HIG 

1979 

2/ 

2 

1:59 

to 

2/ 

2 

22:59 

4098 

to 

3013 

6 

512 

HIG 

1979 

2/ 

1 

23:59 

to 

2/ 

2 

22:59 

4098 

to 

3013 

6 

514 

HIG 

1979 

2/ 

1 

23:59 

to 

2/ 

2 

22:59 

4099 

to 

4099 

1 

604 

OSU 

1979 

2/ 

2 

2:  0 

to 

2/ 

2 

2:  0 

4099 

to 

4100 

2 

1001 

MIT 

1979 

2/ 

2 

2:  0 

to 

2/ 

2 

4:  2 

4102 

to 

3013 

5 

1001 

MIT 

1979 

2/ 

2 

13:59 

to 

2/ 

2 

22:59 

Subtotal  108 


SHOTLINE  DESIGNATION:  SLN1T2 


Event  # s  Num  Instrument  Beginning  and  Ending 

Included  Evnts  I.D,  (Origin)  Data  Start  Times 


4101 

to 

1005 

4 

6 

WHOI 

1979 

2/ 

2 

12:  0 

to 

2/ 

2 

20:  0 

4101 

to 

1005 

4 

7 

WHOI 

1979 

2/ 

2 

12:  0 

to 

2/ 

2 

20:  0 

4101 

to 

1005 

4 

8 

WHOI 

1979 

2/ 

2 

12:  0 

to 

2/ 

2 

20:  0 

4101 

to 

5005 

3 

204 

UTMSI 

1979 

2/ 

2 

11:59 

to 

2/ 

2 

16:59 

4101 

to 

1004 

3 

207 

UTMSI 

1979 

2/ 

2 

11:59 

to 

2/ 

2 

17:59 

1004 

to 

1006 

3 

208 

UTMSI 

1979 

2/ 

2 

17:59 

to 

2/ 

2 

21:59 

1004 

to 

1004 

1 

209 

UTMSI 

1979 

2/ 

2 

17:59 

to 

2/ 

2 

17:59 

1004 

to 

1006 

3 

210 

UTMSI 

1979 

2/ 

2 

17:59 

to 

2/ 

2 

22:  0 

4101 

to 

3013 

9 

302 

SCRIPPS 

1979 

2/ 

2 

11:59 

to 

2/ 

2 

22:59 

4101 

to 

1006 

6 

303 

SCRIPPS 

1979 

2/ 

2 

11:59 

to 

2/ 

2 

21:59 

44 


4101 

to 

4103 

3 

402 

uw 

1979 

2/ 

2 

12:  0 

to 

21 

2 

16:  0 

1004 

to 

1006 

3 

402 

uw 

1979 

2/ 

2 

17:59 

to 

2/ 

2 

21:59 

4101 

to 

4103 

3 

403 

uw 

1979 

2/ 

2 

12:  0 

to 

2/ 

2 

16:  0 

1004 

to 

1006 

3 

403 

uw 

1979 

2/ 

2 

17:59 

to 

2/ 

2 

21:59 

4101 

to 

4103 

3 

405 

uw 

1979 

21 

2 

12:  0 

to 

2/ 

2 

16:  0 

1004 

to 

1006 

3 

405 

uw 

1979 

2/ 

2 

17:59 

to 

2/ 

2 

21:59 

1004 

to 

1006 

3 

406 

uw 

1979 

2/ 

2 

17:59 

to 

2/ 

2 

21:59 

4101 

to 

4103 

3 

407 

uw 

1979 

21 

2 

12:  0 

to 

2/ 

2 

16:  0 

1004 

to 

1006 

3 

407 

uw 

1979 

21 

2 

17:59 

to 

21 

2 

21:59 

1004 

to 

1006 

3 

408 

uw 

1979 

21 

2 

17:59 

to 

2/ 

2 

21:59 

4101 

to 

1006 

6 

502 

HI  G 

1979 

2/ 

2 

11:59 

to 

21 

2 

21:59 

4101 

to 

4103 

3 

503 

HIG 

1979 

21 

2 

11:59 

to 

2/ 

2 

15:59 

4101 

to 

1006 

6 

504 

HIG 

1979 

2/ 

2 

11:59 

to 

2/ 

2 

21:59 

4101 

to 

1006 

6 

506 

HIG 

1979 

2/ 

2 

11:59 

to 

2/ 

2 

21:59 

4101 

to 

1006 

6 

507 

HIG 

1979 

2/ 

2 

11:59 

to 

2/ 

2 

21:59 

4101 

to 

1006 

6 

509 

HIG 

1979 

2/ 

2 

11:59 

to 

2/ 

2 

21:59 

4101 

to 

1006 

6 

510 

HIG 

1979 

21 

2 

11:59 

to 

2/ 

2 

21:59 

4101 

to 

1006 

6 

512 

HIG 

1979 

2/ 

2 

11:59 

to 

2/ 

2 

21:59 

4101 

to 

1006 

6 

514 

HIG 

1979 

2/ 

2 

11:59 

to 

2/ 

2 

21:59 

4101 

to 

3013 

7 

603 

osu 

1979 

2/ 

2 

12:  0 

to 

2/ 

2 

22:59 

4101 

to 

3013 

7 

604 

OSU 

1979 

2/ 

2 

12:  0 

to 

2/ 

2 

22:59 

4101 

to 

4101 

1 

1001 

MIT 

1979 

2/ 

2 

11:59 

to 

2/ 

2 

11:59 

1004 

to 

1006 

3 

1001 

MIT 

1979 

2/ 

2 

17:59 

to 

2/ 

2 

21:59 

Subtotal 

139 

SHOTLINE  DESIGNATION 

1:  SLN1T3 

Event  #s 
Included 

Num 

Evnts 

Instrument 

I.D.  (Origin) 

Beginning  and 
Data  Start 

Ending 

Times 

5001 

to 

1003 

3 

1  WHOI 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

10:  0 

5001 

to 

1003 

4 

2  WHOI 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

10:  0 

5001 

to 

1003 

4 

6  WHOI 

1979 

2/ 

2 

2:59 

to 

21 

2 

10:  0 

5001 

to 

1003 

3 

7  WHOI 

1979 

2/ 

2 

2:59 

to 

21 

2 

10:  0 

5001 

to 

1003 

4 

8  WHOI 

1979 

2/ 

2 

3:  0 

to 

2/ 

2 

10:  0 

5002 

to 

1003 

3 

204  UTMSI 

1979 

2/ 

2 

4:59 

to 

21 

2 

9:59 

1001 

to 

1003 

3 

207  UTMSI 

1979 

2/ 

2 

5:59 

to 

2/ 

2 

9:59 

1001 

to 

1003 

3 

208  UTMSI 

1979 

21 

2 

5:59 

to 

2/ 

2 

9:59 

1001 

to 

1003 

3 

209  UTMSI 

1979 

2/ 

2 

5:59 

to 

2/ 

2 

9:59 

1001 

to 

1003 

3 

210  UTMSI 

1979 

2/ 

2 

5:59 

to 

2/ 

2 

9:59 

1001 

to 

1001 

1 

211  UTMSI 

1979 

2/ 

2 

5:59 

to 

2/ 

2 

5:59 

5001 

to 

5002 

2 

212  UTMSI 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

4:59 

5001 

to 

1003 

5 

302  SCRIPPS 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

10:  2 

5001 

to 

1003 

5 

303  SCRIPPS 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

9:59 

5001 

to 

5002 

2 

402  UW 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

4:59 

1001 

to 

1003 

3 

402  UW 

1979 

2/ 

2 

5:59 

to 

2/ 

2 

10:  0 

5001 

to 

5002 

2 

403  UW 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

4:59 

1003 

1003 

1003 

5001 

1003 

1003 

1003 

1003 

1003 

1003 

1003 

1003 

1002 

1003 

:  #s 

.uded 

5004 

5004 

5005 

5005 

5005 

5005 

5005 

5005 

5005 

5005 

5005 

5005 

5005 

5005 

5005 

5005 

5005 

5005 

5005 


45 


3 

403  UW 

1979 

2/ 

2 

5:59 

to 

2/ 

2 

10:  0 

2 

405  UW 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

4:59 

3 

405  UW 

1979 

2/ 

2 

5:59 

to 

2/ 

2 

10:  0 

3 

406  UW 

1979 

2/ 

2 

5:59 

to 

2/ 

2 

10:  0 

2 

407  UW 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

4:59 

3 

407  UW 

1979 

2/ 

2 

5:59 

to 

2/ 

2 

10:  0 

3 

408  UW 

1979 

2/ 

2 

5:59 

to 

2/ 

2 

10:  0 

5 

502  HIG 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

9:59 

1 

503  HIG 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

2:59 

5 

504  HIG 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

9:59 

5 

506  HIG 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

9:59 

5 

507  HIG 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

9:59 

5 

509  HIG 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

9:59 

5 

510  HIG 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

9:59 

5 

512  HIG 

1979 

2/ 

2 

3:  0 

to 

2/ 

2 

9:59 

5 

514  HIG 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

9:59 

3 

603  OSU 

1979 

2/ 

2 

5:59 

to 

2/ 

2 

9:59 

2 

604  OSU 

1979 

2/ 

2 

5:59 

to 

2/ 

2 

8:  0 

5 

1001  MIT 

1979 

2/ 

2 

2:59 

to 

2/ 

2 

9:59 

Subtotal  123 


SHOTLINE  DESIGNATION:  SLN1T4 


Num  Instrument  Beginning  and  Ending 

Evnts  I.D.  (Origin)  Data  Start  Times 


1 

1 

WHOI 

1979 

2/ 

2 

15:  0 

to 

2/ 

2 

15:  0 

1 

2 

WHOI 

1979 

2/ 

2 

15:  0 

to 

2/ 

2 

15:  0 

3 

212 

UTMSI 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

17:  0 

3 

302 

SCRIPPS 

1979 

21 

2 

12:59 

to 

2/ 

2 

16:59 

3 

303 

SCRIPPS 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

16:59 

3 

402 

UW 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

16:59 

3 

403 

UW 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

16:59 

3 

405 

UW 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

16:59 

3 

407 

UW 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

16:59 

3 

502 

HIG 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

16:59 

1 

503 

HIG 

1979 

2/ 

2 

16:59 

to 

21 

2 

16:59 

3 

504 

HIG 

1979 

21 

2 

12:59 

to 

21 

2 

16:59 

3 

506 

HIG 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

16:59 

3 

507 

HIG 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

16:59 

3 

509 

HIG 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

16:59 

3 

510 

HIG 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

16:59 

3 

512 

HIG 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

16:59 

3 

514 

HIG 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

16:59 

3 

1001 

MIT 

1979 

2/ 

2 

12:59 

to 

2/ 

2 

16:59 

Subtotal  51 
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SHOTLINE  DESIGNATION:  SLN1T5 


Event 

:  ts 

Num 

Instrument 

Beginning 

and 

End ing 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

3003 

to 

3010 

8 

1 

WHOI 

1979 

2/ 

2 

10:59 

to 

21 

2 

14:44 

3003 

to 

3010 

8 

2 

WHOI 

1979 

2/ 

2 

10:59 

to 

21 

2 

14:44 

3001 

to 

3002 

2 

204 

UTMSI 

1979 

21 

2 

6:59 

to 

21 

2 

8:59 

3001 

to 

3003 

3 

212 

UTMSI 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

10:59 

3001 

to 

3003 

3 

302 

SCRIPPS 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

10:59 

3001 

to 

3003 

3 

303 

SCRIPPS 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

10:59 

3001 

to 

3010 

10 

402 

UW 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

14:44 

3001 

to 

3010 

10 

403 

UW 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

14:44 

3001 

to 

3010 

10 

405 

UW 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

14:44 

3001 

to 

3010 

10 

407 

UW 

1979 

2/ 

2 

6:59 

to 

21 

2 

14:44 

3001 

to 

3010 

10 

502 

HIG 

1979 

2/ 

2 

6:59 

to 

21 

2 

14:44 

3001 

to 

3010 

10 

504 

HIG 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

14:44 

3001 

to 

3010 

10 

506 

HIG 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

14:44 

3001 

to 

3010 

10 

507 

HIG 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

14:44 

3001 

to 

3010 

10 

509 

HIG 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

14:44 

3001 

to 

3010 

10 

510 

HIG 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

14:44 

3001 

to 

3010 

10 

512 

HIG 

1979 

2/ 

2 

7:  0 

to 

2/ 

2 

14:44 

3001 

to 

3010 

10 

514 

HIG 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

14:44 

3001 

to 

3010 

10 

603 

osu 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

14:44 

3001 

to 

3010 

10 

604 

osu 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

14:44 

3001 

to 

3003 

3 

1001 

HIT 

1979 

2/ 

2 

6:59 

to 

2/ 

2 

10:59 

Subtotal  170 


SHOTLINE  DESIGNATION:  SLN2L 


Event  #s 


Included 

4110 

to 

4138 

4104 

to 

4138 

4104 

to 

4138 

4105 

to 

4138 

4104 

to 

4121 

4104 

to 

4109 

4104 

to 

4138 

4113 

to 

4138 

4119 

to 

4138 

4123 

to 

4138 

4104 

to 

4109 

4104 

to 

4109 

4104 

to 

4109 

4104 

to 

4109 

Num 

Instrument 

Evnts 

I.D.  (Origin) 

26 

5  WHOI 

1979 

35 

6  WHOI 

1979 

35 

7  WHOI 

1979 

34 

8  WHOI 

1979 

12 

204  UTMSI 

1979 

6 

205  UTMSI 

1979 

23 

207  UTMSI 

1979 

15 

208  UTMSI 

1979 

13 

209  UTMSI 

1979 

11 

210  UTMSI 

1979 

6 

402  UW 

1979 

6 

403  UW 

1979 

6 

405  UW 

1979 

6 

407  UW 

1979 

Beginning  and  Ending 
Data  Start  Times 


2/ 

4 

15:45 

to 

2/ 

5 

0:  0 

2/ 

4 

13:  0 

to 

2/ 

5 

0:  0 

2/ 

4 

13:  0 

to 

21 

5 

0:  0 

2/ 

4 

13:30 

to 

21 

5 

0:  0 

21 

4 

12:59 

to 

2/ 

4 

18:29 

21 

4 

12:59 

to 

2/ 

4 

15:29 

21 

4 

12:59 

to 

21 

4 

23:59 

21 

4 

16:29 

to 

21 

4 

23:59 

21 

4 

17:59 

to 

2/ 

5 

23:59 

21 

4 

18:59 

to 

2/ 

5 

23:59 

2/ 

4 

13:  0 

to 

2/ 

4 

15:30 

2/ 

4 

13:  0 

to 

2/ 

4 

15:30 

2/ 

4 

13:  0 

to 

2/ 

4 

15:30 

21 

4 

13:  0 

to 

2/ 

4 

15:30 

4138 

4138 

4138 

4138 

4137 

4136 

4133 

4117 

4137 

:  #s 

Luded 

4372 

4372 

4403 

4337 

4409 

4426 

4338 

4403 

4334 

4393 

4426 

4468 

4272 

4290 

t  #s 

luded 

3122 

3076 

3133 

3133 


47 


33 

507 

HIG 

1979 

2/ 

4 

12:59 

to 

2/ 

4 

23:59 

35 

509 

HIG 

1979 

21 

4 

12:59 

to 

2/ 

4 

23:59 

35 

510 

HIG 

1979 

2/ 

4 

12:59 

to 

2/ 

4 

23:59 

35 

512 

HIG 

1979 

2/ 

4 

13:28 

to 

2/ 

4 

23:59 

34 

514 

HIG 

1979 

2/ 

4 

12:59 

to 

2/ 

4 

23:29 

30 

603 

OSU 

1979 

2/ 

4 

13:59 

to 

2/ 

4 

22:59 

21 

604 

OSU 

1979 

2/ 

4 

14:30 

to 

2/ 

4 

21:30 

14 

1001 

MIT 

1979 

2/ 

4 

12:59 

to 

2/ 

4 

17:29 

19 

1001 

MIT 

1979 

2/ 

4 

17:44 

to 

2/ 

4 

23 : 29 

Subtotal  492 


SHOTLINE  DESIGNATION:  SLN2S 


Num  Instrument  Beginning  and  Ending 

Evnts  I.D.  (Origin)  Data  Start  Times 


220 

7 

WHOI 

1979 

2/ 

6 

5:  5 

to 

2/ 

7 

0:25 

222 

8 

WHO  I 

1979 

2/ 

6 

5:10 

to 

2/ 

7 

0:25 

2 

205 

UTMSI 

1979 

2/ 

6 

22:59 

to 

2/ 

7 

2:59 

23 

207 

UTMSI 

1979 

2/ 

6 

6:59 

to 

21 

6 

21:29 

17 

210 

UTMSI 

1979 

2/ 

6 

18:59 

to 

21 

7 

3:29 

276 

507 

HIG 

1979 

2/ 

6 

4:59 

to 

21 

7 

4:54 

191 

509 

HIG 

1979 

2/ 

6 

4:59 

to 

21 

6 

21:34 

62 

509 

HIG 

1979 

21 

6 

21:39 

to 

2f 

7 

02:59 

170 

510 

HIG 

1979 

21 

6 

6:29 

to 

21 

6 

21:14 

208 

603 

OSU 

1979 

2/ 

6 

4:59 

to 

21 

7 

2:  9 

23 

603 

OSU 

1979 

2/ 

7 

2:14 

to 

21 

7 

4:54 

180 

604 

OSU 

1979 

2/ 

6 

5:  0 

to 

2/ 

13 

2:30 

22 

1001 

MIT 

1979 

2/ 

6 

13:59 

to 

2/ 

6 

16 :  4 

18 

1001 

MIT 

1979 

2/ 

6 

16:  9 

to 

21 

6 

17:34 

Subtotal  1634 


SHOTLINE  DESIGNATION:  SLN3A 


Num  Instrument  Beginning  and  Ending 

Evnts  I.D.  (Origin)  Data  Start  Times 


10 

208  UTMSI 

1979 

2/ 

8 

11:59 

to 

21 

8 

16:29 

62 

504  HIG 

1979 

2/ 

8 

11:59 

to 

21 

8 

14:34 

119 

505  HIG 

1979 

2/ 

8 

11:59 

to 

21 

8 

16:57 

119 

506  HIG 

1979 

2/ 

8 

11:59 

to 

21 

8 

16:57 

Subtotal  310 
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SHOTLINE  DESIGNATION:  SLN3L 

Event  #s  Num  Instrument  Beginning  and  Ending 


Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

1007 

to 

1041 

35 

1  WHOI 

1979 

2/ 

3 

21:  0 

to 

21 

4 

8:  0 

1007 

to 

1041 

34 

2  WHOI 

1979 

2/ 

3 

21:  0 

to 

2/ 

4 

7:59 

1007 

to 

1041 

34 

6  WHOI 

1979 

2/ 

3 

21:  0 

to 

2/ 

4 

7:59 

1007 

to 

1041 

34 

7  WHOI 

1979 

2/ 

3 

21:  0 

to 

2/ 

4 

7:59 

1007 

to 

1041 

34 

8  WHOI 

1979 

2/ 

3 

21:  0 

to 

2/ 

4 

7:59 

1007 

to 

1022 

11 

204  UTMSI 

1979 

2/ 

3 

20:59 

to 

2/ 

4 

1:59 

1007 

to 

1040 

11 

205  UTMSI 

1979 

2/ 

3 

20:59 

to 

2/ 

4 

7:29 

1007 

to 

1041 

23 

207  UTMSI 

1979 

2/ 

3 

20:59 

to 

2/ 

4 

7:59 

1018 

to 

1041 

23 

208  UTMSI 

1979 

2/ 

3 

0:59 

to 

2/ 

4 

7:59 

1010 

to 

1041 

20 

209  UTMSI 

1979 

2/ 

3 

22:29 

to 

2/ 

4 

7:59 

1011 

to 

1041 

18 

210  UTMSI 

1979 

21 

3 

22:59 

to 

2/ 

4 

7:59 

1007 

to 

1041 

35 

402  UW 

1979 

21 

3 

21:  0 

to 

2/ 

4 

7:59 

1007 

to 

1041 

35 

403  UW 

1979 

2/ 

3 

21:  0 

to 

2/ 

4 

7:59 

1007 

to 

1041 

35 

405  UW 

1979 

2/ 

3 

21:  0 

to 

21 

4 

7:59 

1007 

to 

1041 

33 

406  UW 

1979 

2/ 

3 

21:  0 

to 

2/ 

4 

7:59 

1007 

to 

1041 

35 

407  UW 

1979 

2/ 

3 

21:  0 

to 

2/ 

4 

7:59 

1007 

to 

1041 

35 

408  UW 

1979 

21 

3 

21:  0 

to 

2/ 

4 

7:59 

1007 

to 

1041 

35 

504  HIG 

1979 

21 

3 

20:59 

to 

2/ 

4 

7:59 

1007 

to 

1041 

35 

505  HIG 

1979 

21 

3 

20:59 

to 

2/ 

4 

7:59 

1007 

to 

1041 

35 

506  HIG 

1979 

2/ 

3 

20:59 

to 

2/ 

4 

7:59 

1007 

to 

1041 

32 

603  OSU 

1979 

2/ 

2 

21:  0 

to 

2/ 

3 

7:59 

1007 

to 

1041 

31 

604  OSU 

1979 

2/ 

2 

21:  0 

to 

2/ 

3 

7:59 

1007 

to 

1018 

12 

1001  MIT 

1979 

2/ 

3 

20:59 

to 

2/ 

4 

1:  0 

1019 

to 

1030 

12 

1001  MIT 

1979 

2/ 

4 

1:15 

to 

21 

4 

4:  0 

1031 

to 

1041 

10 

1001  MIT 

1979 

2/ 

4 

4:14 

to 

2/ 

4 

7:59 

Subtotal  687 


SHOTLINE  DESIGNATION:  SLN3S 


Event  #s 
Included 

Num 

Evnts 

Instrument 

I.D.  (Origin) 

Beginning  and 
Data  Start 

End ing 
Times 

1380 

to 

1447 

68 

205  UTMSI 

1979 

2/ 

7 

7:  4 

to 

2/ 

7 

12:39 

1380 

to 

1447 

68 

207  UTMSI 

1979 

2/ 

7 

7:  4 

to 

2/ 

7 

12:39 

1438 

to 

1619 

160 

208  UTMSI 

1979 

2/ 

7 

11:54 

to 

2/ 

8 

2:59 

1584 

to 

1619 

133 

209  UTMSI 

1979 

2/ 

7 

0:  4 

to 

2/ 

8 

2:59 

1477 

to 

1563 

135 

210  UTMSI 

1979 

2/ 

7 

15:  9 

to 

2/ 

8 

22:19 

1480 

to 

1619 

139 

408  UW 

1979 

2/ 

7 

15:25 

to 

2/ 

8 

3:  0 

1380 

to 

1619 

240 

504  HIG 

1979 

2/ 

7 

7:  4 

to 

2/ 

8 

2:59 

1380 

to 

1619 

239 

506  HIG 

1979 

2/ 

7 

7:  4 

to 

2/ 

8 

2:59 

Subtotal  1182 
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SHOTLINE  DESIGNATION:  SLN4L 


Event  #s 

Num 

Instrument 

Beginning 

and 

Ending 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

4439 

to 

4473 

34 

1  WHO  I 

1979 

2/12 

18:00 

to 

2/13 

5:  0 

4439 

to 

4466 

25 

2  WHO  I 

1979 

2/12 

18:00 

to 

2/13 

2:  0 

4439 

to 

4473 

33 

3  WHOI 

1979 

2/12 

18:00 

to 

2/13 

5:  0 

4439 

to 

4473 

34 

4  WHOI 

1979 

2/12 

18:00 

to 

2/13 

5:  0 

4439 

to 

4473 

34 

7  WHOI 

1979 

2/12 

18:00 

to 

2/13 

5:  0 

4439 

to 

4473 

33 

8  WHOI 

1979 

2/12 

18:  0 

to 

2/13 

5:  0 

4439 

to 

4473 

34 

402  UW 

1979 

2/12 

18:  0 

to 

2/13 

5:  0 

4439 

to 

4473 

34 

403  UW 

1979 

2/12 

18:  0 

to 

2/13 

5:  0 

4439 

to 

4466 

28 

405  UW 

1979 

2/12 

18:  0 

to 

2/13 

2:  0 

4439 

to 

4473 

34 

407  UW 

1979 

2/12 

18:  0 

to 

2/13 

5:  0 

4439 

to 

4473 

34 

502  HIG 

1979 

2/12 

17:59 

to 

2/13 

4:59 

443  9 

to 

4473 

34 

503  HIG 

1979 

2/12 

17:59 

to 

2/13 

4:59 

4468 

to 

4473 

5 

701  MIT 

1979 

2/13 

2:30 

to 

2/13 

5:  0 

Subtotal  396 


SHOTLINE  DESIGNATION:  SLN4S 

Event  #s  Num  Instrument  Beginning  and  Ending 


Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

2040 

to 

2252 

181 

1  WHOI 

1979 

2/11 

22:35 

to 

2/12 

16:15 

2036 

to 

2240 

181 

3  WHOI 

1979 

2/11 

22:14 

to 

2/12 

15:15 

1991 

to 

2224 

201 

4  WHOI 

1979 

2/11 

18:30 

to 

2/12 

13:55 

2052 

to 

2256 

173 

7  WHOI 

1979 

2/11 

23:35 

to 

2/12 

16:35 

2077 

to 

2263 

155 

8  WHOI 

1979 

2/12 

1:39 

to 

2/12 

17:10 

2099 

to 

2189 

13 

211  UTMSI 

1979 

2/12 

3:29 

to 

2/12 

11:  0 

1998 

to 

2263 

277 

402  UW 

1979 

2/11 

18:  4 

to 

2/12 

17:10 

1998 

to 

2263 

277 

403  UW 

1979 

2/11 

18:  4 

to 

2/12 

17:10 

1998 

to 

2263 

276 

405  UW 

1979 

2/11 

18:  4 

to 

2/12 

17:10 

1998 

to 

2263 

257 

406  UW 

1979 

2/11 

18:  4 

to 

2/12 

17:10 

1998 

to 

2263 

277 

407  UW 

1979 

2/11 

18:  4 

to 

2/12 

17:10 

2122 

to 

2263 

142 

502  HIG 

1979 

2/12 

5:24 

to 

2/12 

17:  9 

1998 

to 

2263 

278 

503  HIG 

1979 

2/11 

18:  4 

to 

2/12 

17:  9 

2211 

to 

2263 

27 

701  MIT 

1979 

2/12 

12:50 

to 

2/12 

17:10 

Subtotal  2715 


50 


SHOTLINE  DESIGNATION:  SLN5L 


Event 

;  #s 

Num 

Instrument 

Beginning 

and 

Ending 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

5037 

to 

5054 

17 

7  WHOI 

1979 

2/10 

6:30 

to 

2/10 

11:30 

5048 

to 

5054 

7 

8  WHOI 

1979 

2/10 

9:45 

to 

2/10 

11:30 

5036 

to 

5054 

11 

211  UTMSI 

1979 

2/10 

5:59 

to 

2/10 

11:29 

5036 

to 

5054 

11 

212  UTMSI 

1979 

2/10 

5:59 

to 

2/10 

11:29 

5036 

to 

5054 

18 

402  UW 

1979 

2/10 

5:59 

to 

2/10 

11:30 

5036 

to 

5054 

18 

403  UW 

1979 

2/10 

5:59 

to 

2/10 

11:30 

5036 

to 

5054 

18 

405  UW 

1979 

2/10 

5:59 

to 

2/10 

11:30 

5036 

to 

5054 

18 

407  UW 

1979 

2/10 

5:59 

to 

2/10 

11:30 

5036 

to 

5038 

3 

701  MIT 

1979 

2/10 

6:  0 

to 

2/10 

7:  0 

Subtotal 

121 

SHOTLINE  DESIGNATION:  SLN5S 

Event 

:  #s 

Num 

Instrument 

Beginning 

and 

Ending 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

1620 

to 

1760 

124 

211  UTMSI 

1979 

2/ 

8 

17:  0 

to 

2/  9 

4:39 

1654 

to 

1810 

156 

212  UTMSI 

1979 

2/ 

8 

19:49 

to 

2/  9 

8:49 

1620 

to 

1810 

191 

402  UW 

1979 

2/ 

8 

16:59 

to 

21  9 

8:50 

1620 

to 

1810 

191 

403  UW 

1979 

2/ 

8 

16:59 

to 

2/  9 

8:50 

1620 

to 

1810 

191 

405  UW 

1979 

2/ 

8 

16:59 

to 

2/  9 

8:50 

1620 

to 

1810 

168 

406  UW 

1979 

2/ 

8 

16:59 

to 

2/  9 

8:50 

1620 

to 

1810 

191 

407  UW 

1979 

21 

8 

16:59 

to 

2/  9 

8:50 

Subtotal 

1212 

SHOTLINE  DESIGNATION:  SLN6L 

Event 

;  #s 

Num 

Instrument 

Beginning 

and 

Ending 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

4427 

to 

4438 

12 

2  WHOI 

1979 

2/ 

8 

6:59 

to 

2/  8 

11:30 

4427 

to 

4431 

5 

208  UTMSI 

1979 

2/ 

8 

6:59 

to 

2/  8 

8:59 

4427 

to 

4438 

10 

211  UTMSI 

1979 

2/ 

8 

6:59 

to 

2/  8 

11:29 

4427 

to 

4438 

12 

402  UW 

1979 

2/ 

8 

6:59 

to 

2/  8 

11:30 

4427 

to 

4438 

12 

403  UW 

1979 

2/ 

8 

6:59 

to 

2/  8 

11:30 

51 


4427 

to 

4438 

12 

405  UW 

1979 

2/ 

8 

6:59 

to 

2/ 

8 

11:30 

4427 

to 

4438 

12 

407  UW 

1979 

2/ 

8 

6:59 

to 

2/ 

8 

11:30 

4427 

to 

4438 

12 

503  HIG 

1979 

2/ 

8 

6:59 

to 

2/ 

8 

11:29 

4428 

to 

4437 

5 

603  OSU 

1979 

2/ 

8 

7:29 

to 

21 

8 

10:59 

4427 

to 

4438 

12 

701  MIT 

1979 

2/ 

8 

6:59 

to 

2/ 

8 

11:30 

Subtotal 

104 

SHOTLINE 

DESIGNATION 

t:  SLN6S 

Event 

.  #s 

Num 

Instrument 

Beginning 

and 

Ending 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

3146 

to 

3236 

16 

211 

UTMSI 

1979 

2/10 

17:59 

to 

2/11 

1:29 

3134 

to 

3241 

108 

402 

UW 

1979 

2/10 

16:59 

to 

2/11 

1:55 

3134 

to 

3241 

108 

403 

UW 

1979 

2/10 

16:59 

to 

2/11 

1:55 

3134 

to 

3241 

108 

405 

UW 

1979 

2/10 

16 : 59 

to 

2/11 

1:55 

3134 

to 

3241 

108 

407 

UW 

1979 

2/10 

16:59 

to 

2/11 

1:55 

3134 

to 

3241 

108 

503 

HIG 

1979 

2/10 

16:59 

to 

2/11 

1:54 

3184 

to 

3240 

38 

701 

MIT 

1979 

2/10 

21:10 

to 

2/11 

1:49 

Subtotal 

594 

SHOTLINE  DESIGNATION 

1:  SLN7L 

Event 

#s 

Num 

Instrument 

Beginning 

and 

Ending 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

5057 

to 

5066 

10 

7  WHO  I 

1979 

2/10 

13:  0 

to 

2/10 

16:30 

5057 

to 

5066 

10 

8  WHO  I 

1979 

2/10 

13:  0 

to 

2/10 

16:30 

5057 

to 

5065 

6 

211  UTMSI 

1979 

2/10 

12:59 

to 

2/10 

15:59 

5057 

to 

5065 

10 

212  UTMSI 

1979 

2/10 

12:59 

to 

2/11 

15:59 

5057 

to 

5068 

12 

402  UW 

1979 

2/10 

13:  0 

to 

2/10 

17:30 

5057 

to 

506  8 

12 

403  UW 

1979 

2/10 

13:  0 

to 

2/10 

17:30 

5057 

to 

506  8 

12 

405  UW 

1979 

2/10 

13:  0 

to 

2/10 

17:30 

5057 

to 

506  8 

12 

407  UW 

1979 

2/10 

13:  0 

to 

2/10 

17:30 

Subtotal 

84 

52 


SHOTLINE  DESIGNATION:  SLN7S 


Event 

.  #s 

Num 

Instrument 

Beginning  and 

Ending 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Timei 

s 

506  9 

to 

5171 

18 

212  UTMSI 

1979 

2/11 

8:59  to 

2/11 

17:29 

5069 

to 

5176 

108 

402  UW 

1979 

2/11 

9:  0  to 

2/11 

17:54 

5069 

to 

5152 

84 

403  UW 

1979 

2/11 

9:  0  to 

2/11 

15:55 

506  9 

to 

5176 

106 

405  UW 

1979 

2/11 

9:  0  to 

2/11 

17:54 

5069 

to 

5176 

108 

407  UW 

1979 

2/11 

9:  0  to 

2/11 

17:54 

Subtotal 

424 

SHOTLINE  DESIGNATION:  QUAKE 1 

Event 

#s 

Num 

Instrument 

Beginning  and 

Ending 

Included 

Evnts 

I.D.  (Orig 

in) 

Data  Start 

Times 

1 

to 

1 

1 

509  HIG 

1979 

2/  2 

0:54  to 

2/  2  0:54 

1 

to 

46 

46 

517  HIG 

1979 

2/27 

21:30  to 

3/  8  18:33 

1 

to 

2 

2 

701  MIT 

1979 

2/12 

1:59  to 

2/12  2:  0 

Subtotal  49 


Total  Number  of  Events  for  Phase  1 :  17 . 164 


53 


PHASE  2  EVENTS 


SHOTLINE  DESIGNATION:  SLN1N 

Event 

Num 

Instrument 

Beginning  and 

Ending 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

3242 

to 

3330 

89 

5  WHO  I 

1979 

2/28 

0:  0  to 

2/28 

7: 

3242 

to 

3330 

89 

6  WHOI 

1979 

2/28 

0:  0  to 

2/28 

7: 

3244 

to 

3319 

34 

210  UTMSI 

1979 

2/28 

0:10  to 

2/28 

6: 

3242 

to 

3304 

63 

213  UTMSI 

1979 

2/28 

0:  0  to 

2/28 

5: 

3242 

to 

3331 

88 

608  OSU 

1979 

2/28 

0:  0  to 

2/28 

7: 

3242 

to 

3331 

89 

611  OSU 

1979 

2/28 

0:  0  to 

2/28 

7: 

3256 

to 

3331 

71 

612  OSU 

1979 

2/28 

1:10  to 

2/28 

7: 

Subtotal 

523 

SHOTLINE  DESIGNATION 

1:  SLN2N 

Event 

.  #s 

Num 

Instrument 

Beginning  and 

Ending 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

3370 

to 

3421 

52 

205  UTMSI 

1979 

2/28  18:10  to 

2/28  22: 

3333 

to 

3419 

79 

210  UTMSI 

1979 

2/28  15:  5  to 

2/28  22: 

3332 

to 

3421 

89 

608  OSU 

1979 

2/28  15:  0  to 

2/28  22: 

3332 

to 

3403 

72 

611  OSU 

1979 

2/28  15:  0  to 

2/28  20: 

3404 

to 

3421 

18 

611  OSU 

1979 

2/28  20:59  to 

2/28  22: 

3332 

to 

3421 

75 

612  OSU 

1979 

2/28  15:  0  to 

2/28  22: 

Subtotal 

385 

SHOTLINE  DESIGNATION 

:  SLN3N 

Event 

#s 

Num 

Instrument 

Beginning 

and 

Ending 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

4474 

to 

4563 

86 

2  WHOI 

1979 

2/28  7:30 

to 

2/28  14: 

4474 

to 

4563 

85 

3  WHOI 

1979 

2/28  7:30 

to 

2/28  14: 

4506 

to 

4563 

14 

210  UTMSI 

1979 

2/28  10:10 

to 

2/28  14: 

19 

19 

25 

10 

25 

25 

25 

24 

15 

24 

55 

24 

24 

55 

55 

55 


54 


4474 

to 

4538 

64 

608  OSU 

1979 

2/28 

7:30 

to 

2/28 

12:50 

4540 

to 

4563 

23 

608  OSU 

1979 

2/28 

13:  0 

to 

2/28 

14:55 

4474 

to 

4563 

88 

611  OSU 

1979 

2/28 

7:30 

to 

2/28 

14:55 

4474 

to 

4538 

63 

612  OSU 

1979 

2/28 

7:30 

to 

2/28 

12:50 

4540 

to 

4562 

20 

612  OSU 

1979 

2/28 

13:  0 

to 

2/28 

14:49 

Subtotal 

443 

SHOTLINE  DESIGNATION:  SLN4N 

Event  #s 

Num 

Instrument 

Beginning  and 

Ending 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

4573 

to 

4655 

79 

210  UTMSI 

1979 

2/28  23:15  to 

3/  1 

6:54 

4641 

to 

4655 

14 

213  UTMSI 

1979 

2/28  5:44  to 

2/28 

6:54 

4642 

to 

4649 

7 

214  UTMSI 

1979 

3/  1  5:50  to 

3/  1 

6:25 

4564 

to 

4655 

87 

608  OSU 

1979 

2/28  22:30  to 

3/  1 

6:54 

4564 

to 

4655 

90 

611  OSU 

1979 

2/28  22:30  to 

3/  1 

6:54 

4564 

to 

4655 

83 

612  OSU 

1979 

2/28  22:30  to 

3/  1 

6:54 

Subtotal 

360 

SHOTLINE  DESIGNATION:  SLN5N 

Event  #s 

Num 

Instrument 

Beginning 

and 

End ing 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

3425 

to 

3427 

3 

1  WHOI 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3425 

to 

3427 

3 

2  WHOI 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3425 

to 

3427 

3 

3  WHOI 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3425 

to 

3427 

3 

4  WHOI 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3425 

to 

3427 

3 

5  WHOI 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3425 

to 

3427 

3 

6  WHOI 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3425 

to 

3427 

3 

7  WHOI 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3425 

to 

3427 

3 

8  WHOI 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3425 

to 

3425 

1 

204  UTMSI 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

17:20 

3425 

to 

3427 

3 

205  UTMSI 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3425 

to 

3427 

3 

210  UTMSI 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3426 

to 

3427 

2 

213  UTMSI 

1979 

3/ 

4 

20:15 

to 

3/ 

4 

22:15 

3425 

to 

3426 

2 

214  UTMSI 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

20:14 

3425 

to 

3427 

3 

302  SCRIPPS 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3425 

to 

3427 

3 

303  SCRIPPS 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3425 

to 

3427 

3 

304  SCRIPPS 

1979 

3/ 

4 

17:21 

to 

3/ 

4 

22:16 

3425 

to 

3427 

3 

608  OSU 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3425 

to 

3427 

3 

611  OSU 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

3425 

to 

3427 

2 

612  OSU 

1979 

3/ 

4 

17:20 

to 

3/ 

4 

22:15 

55 


3425 

to 

3427 

3 

705  MIT 

1979 

3/ 

4 

17:21 

to 

3/ 

4 

22:15 

3425 

to 

3427 

3 

706  MIT 

1979 

3/ 

4 

17:21 

to 

3/ 

4 

22:15 

3425 

to 

3427 

3 

801  UCSB 

1979 

3/ 

4 

17:21 

to 

3/ 

4 

22:15 

Subtotal  61 


SHOTLINE  DESIGNATION:  SLN6N 


Event  # s  Num  Instrument  Beginning  and  Ending 

Included  Evnts  I.D.  (Origin)  Data  Start  Times 


3428 

to 

3432 

5 

1  WHO  I 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:46 

3428 

to 

3432 

5 

2  WHO  I 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:46 

3428 

to 

3432 

5 

3  WHOI 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:46 

3428 

to 

3430 

2 

4  WHOI 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

15:44 

3428 

to 

3432 

5 

5  WHOI 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:46 

3428 

to 

3432 

5 

6  WHOI 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:46 

3428 

to 

3432 

5 

7  WHOI 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:46 

3428 

to 

3432 

5 

8  WHOI 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:46 

3428 

to 

3432 

5 

204  UTMSI 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:46 

3428 

to 

3432 

5 

205  UTMSI 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:46 

3428 

to 

3432 

5 

210  UTMSI 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:46 

3428 

to 

3432 

3 

213  UTMSI 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:46 

3430 

to 

3432 

3 

301  SCRIPPS 

1979 

3/ 

5 

15:44 

to 

3/ 

5 

22:47 

3428 

to 

3432 

5 

302  SCRIPPS 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:46 

3428 

to 

3432 

5 

303  SCRIPPS 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:47 

3428 

to 

3428 

1 

304  SCRIPPS 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

1:14 

3428 

to 

3432 

5 

608  OSU 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:47 

3428 

to 

3432 

5 

611  OSU 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:47 

3428 

to 

3431 

3 

612  OSU 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

19:21 

3428 

to 

3432 

5 

705  MIT 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:47 

3428 

to 

3432 

5 

706  MIT 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

22:46 

3428 

to 

3428 

1 

801  UCSB 

1979 

3/ 

5 

1:14 

to 

3/ 

5 

1:14 

3430 

to 

3432 

2 

802  UCSB 

1979 

3/ 

5 

15:45 

to 

3/ 

5 

22:47 

Subtotal  95 


SHOTLINE  DESIGNATION:  SLN7N 


Event  vs  Num  Instrument  Beginning  and  Ending 

Included  Evnts  I.D.  (Origin)  Data  Start  Times 


3433 

to 

3438 

6 

1 

WHOI 

3433 

to 

3438 

6 

2 

WHOI 

3433 

to 

3438 

6 

3 

WHOI 

3433 

to 

3438 

6 

4 

WHOI 

1979  3/  6  1:26  to  3/  6  23:37 

1979  3/  6  1:26  to  3/  6  23:37 

1979  3/  6  1:26  to  3/  6  23:37 

1979  3/  6  1:26  to  3/  6  23:37 


56 


3433 

to 

3438 

6 

5  WHOI 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:37 

3433 

to 

3438 

6 

6  WHOI 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:37 

3433 

to 

3438 

6 

7  WHOI 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:37 

3433 

to 

3438 

6 

8  WHOI 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:37 

3433 

to 

3438 

6 

204  UTMSI 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:37 

3433 

to 

3438 

6 

205  UTMSI 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:37 

3433 

to 

3437 

4 

210  UTMSI 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

21:37 

3433 

to 

3438 

5 

213  UTMSI 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:37 

3433 

to 

3438 

6 

301  SCRIPPS 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:37 

3433 

to 

3438 

5 

302  SCRIPPS 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:38 

3433 

to 

3438 

6 

303  SCRIPPS 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:38 

3433 

to 

3438 

6 

608  OSU 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:37 

3433 

to 

3438 

6 

611  OSU 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:37 

3433 

to 

3438 

6 

705  MIT 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:38 

3433 

to 

3438 

6 

706  MIT 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:37 

3433 

to 

3438 

6 

802  UCSB 

1979 

3/ 

6 

1:26 

to 

3/ 

6 

23:37 

Subtotal 

116 

SHOTLINE  DE SI GNAT 101 

1:  SLN8N 

Event  #s 

Num 

Instrument 

Beginning 

and  Ending 

Included 

Evnts 

I.D.  (Origin) 

Data  Start 

Times 

3440 

to 

3442 

3 

1  WHOI 

1979 

3/ 

7 

17:20 

to 

3/ 

7 

22:45 

3440 

to 

3442 

3 

2  WHOI 

1979 

3/ 

7 

17:20 

to 

3/ 

7 

22:45 

3440 

to 

3442 

3 

3  WHOI 

1979 

3/ 

7 

17:20 

to 

3/ 

7 

22:45 

3440 

to 

3442 

3 

4  WHOI 

1979 

3/ 

7 

17:20 

to 

3/ 

7 

22:45 

3440 

to 

3442 

3 

5  WHOI 

1979 

3/ 

7 

17:20 

to 

3/ 

7 

22:45 

3440 

to 

3442 

3 

6  WHOI 

1979 

3/ 

7 

17:20 

to 

3/ 

7 

22:45 

3440 

to 

3442 

3 

7  WHOI 

1979 

3/ 

7 

17:20 

to 

3/ 

7 

22:45 

3440 

to 

3442 

3 

8  WHOI 

1979 

3/ 

7 

17:20 

to 

3/ 

7 

22:45 

3442 

to 

3442 

1 

204  UTMSI 

1979 

3/ 

7 

22:45 

to 

3/ 

7 

22:45 

3442 

to 

3442 

1 

205  UTMSI 

1979 

3/ 

6 

22:45 

to 

3/ 

6 

22:45 

3441 

to 

3442 

2 

210  UTMSI 

1979 

3/ 

7 

20:12 

to 

3/ 

7 

20:45 

3440 

to 

3442 

3 

301  SCRIPPS 

1979 

3/ 

7 

17:20 

to 

3/ 

7 

22:45 

3440 

to 

3442 

3 

302  SCRIPPS 

1979 

3/ 

7 

17:21 

to 

3/ 

7 

22:45 

3440 

to 

3442 

3 

303  SCRIPPS 

1979 

3/ 

7 

17:21 

to 

3/ 

7 

22:45 

3441 

to 

3442 

2 

608  OSU 

1979 

3/ 

7 

20:12 

to 

3/ 

7 

22:45 

3440 

to 

3442 

3 

611  OSU 

1979 

3/ 

7 

17:20 

to 

3/ 

7 

22:45 

3440 

to 

3442 

3 

705  MIT 

1979 

3/ 

7 

17:20 

to 

3/ 

7 

22:45 

3440 

to 

3442 

3 

706  MIT 

1979 

3/ 

7 

17:20 

to 

3/ 

7 

22:45 

3440 

to 

3442 

3 

802  UCSB 

1979 

3/ 

7 

17:21 

to 

3/ 

7 

22:45 

Subtotal 

51 

SHOTLINE  DESIGNATION:  QUAKE2 


Event  #s  Num  Instrument  Beginning  and  Ending 

Included  Evnts  I.D.  (Origin)  Data  Start  Times 


5 

to 

68 

39 

202  UTMSI 

1979  2/27 

15:47 

to 

3/  1 

20:49 

1 

to 

55 

9 

203  UTMSI 

1979 

2/27 

13:  7 

to 

3/  1 

15:  6 

24 

to 

329 

141 

204  UTMSI 

1979 

2/27 

22:38 

to 

3/15 

17:56 

24 

to 

330 

97 

205  UTMSI 

1979 

2/27 

22:38 

to 

3/15 

18:35 

24 

to 

332 

52 

210  UTMSI 

1979 

2/27 

22:38 

to 

3/16 

7:  0 

12 

to 

267 

59 

213  UTMSI 

1979 

2/27 

18:  8 

to 

3/  8 

18:32 

2 

to 

230 

143 

214  UTMSI 

1979 

2/27 

13:25 

to 

3/  8 

8:52 

1014  to 

1399 

186 

301  SCRIPPS 

1979  3/  1 

14:57 

to 

3/13 

4:13 

2004  to 

2098 

16 

302  SCRIPPS 

1979  3/  4 

•  4:59 

1  to 

4/21 

9:54 

3004  to 

3134 

21 

303  SCRIPPS 

1979  3/  3 

14:59 

►  to 

3/  9 

17:38 

4100  to 

4408 

64 

304  SCRIPPS 

1979  3/  2 

:  0:17 

to 

3/  5 

8:42 

1 

to 

130 

130 

608  0SU 

1979 

2/27 

11:30 

to 

3/14 

14:  3 

131 

to 

275 

145 

608  OSU 

1979 

3/14 

14:16 

to 

3/17 

4:38 

1 

to 

121 

121 

611  OSU 

1979 

2/27 

22:38 

to 

3/14  20:38 

146 

to 

226 

81 

611  OSU 

1979 

3/15 

5:12 

to 

3/20 

22:57 

1 

to 

108 

108 

612  OSU 

1979 

3/  1 

6:54 

to 

3/16 

6:59 

1 

to 

260 

258 

614  OSU  ** 

1979 

3/26 

0:37 

to 

3/31 

15:15 

261 

to 

516 

255 

614  OSU  ** 

1979 

3/31 

18:23 

to 

4/  6 

5:51 

517 

to 

664 

146 

614  OSU  ** 

1979 

4/  6 

6:12 

to 

4/10 

18:  4 

1 

to 

138 

138 

616  OSU  ** 

1979 

3/26 

15:28 

to 

4/11 

22:59 

0 

to 

0 

19 

705  MIT 

1979 

3/  2 

5:23 

to 

3/13 

18:49 

0 

to 

0 

37 

706  MIT 

1979 

3/  2 

5:23 

to 

3/  8 

12:38 

0 

to 

0 

78 

801  UCSB 

1979 

3/  1 

12:16 

to 

3/  5 

0:58 

0 

to 

0 

49 

802  UCSB 

1979 

3/  5 

8:40 

to 

3/  9 

0:43 

Subtotal 

2392 

**  These  events  were  collected  after  Phase  II;  a  third  deployment 
off  the  coast  of  Mexico,  near  the  Petatlan  site. 


Total  Number  of  Events  for  Phase  2 :  4.426 


SUMMARY  OF  EVENTS  BY  INSTITUTE 


HIG  4,377 
MIT  342 
OSU  3,010 
SCRIPPS  565 
UCSB  142 
UTMSI  2,424 
UW  5,216 
WHO I  5,514 


TOTAL  STORED  EVENTS  21,590 


PHASE  1 


PHASE  2 
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Rose  Shotline  Number  Designations 
used  in  Rose  Archive 


Shotline 

Shot  numbers 

Ship  code 

1L 

5006-5035 

D 

IS 

1042-1378 

T 

2L 

4104-4138 

K 

2S 

4139-4426 

K 

3L 

1007-1041 

T 

3S 

1379-1619 

T 

3A 

3014-3133 

C 

4L 

4439-4473  &  4993 

K 

4S 

1986-2263 

T 

5L 

5036-5054 

D 

5S 

1620-1810 

T 

6L 

4427-4438 

K 

6S 

3134-3241 

C 

7L 

5057-5068 

D 

7S 

5069-5176 

D 

4H 

4991-4992  &  4001-4054 

K 

2H 

4056-4097 

K 

«  1  TON  SHOTS  » 

1T1 

3011-3013 

C 

&  4098-4100 

K 

1T2 

1004-1006 

T 

&  4101-4103 

K 

1T3 

1001-1003 

T 

&  5001-5002 

D 

1T4 

5003-5005 

D 

1T5 

3001-3010 

C 

«  MAXIPULSE  AND  AIRGUN  » 

1H 

8001-8722 

K 

2M 

9001-11360 

K 

3M 

11362-12219 

K 

4M 

12220-12639 

K 

1AG 

6001-7640 

C 

Shotline 

Shot  numbers 

Ship  code 

IN 

3242-3331 

C 

2N 

3332-3421 

C 

3N 

4474-4563 

K 

4N 

4564-4655 

K 

5N 

3425-3427 

C 

6N 

3428-3432 

C 

7N 

3433-3438 

C 

8N 

3439-3442 

C 

5T 

4927-4928 

K 

Ship  codes:  C=Conrad;  D=DeSteiger;  K=Kana  Keoki;  and  T=  Thompson 


60 


o 


o 


OJ 

o 


ro 

O 


o 


in 

O 


5 

O 

<£> 

o 


Locations  of  instrument  deployments  and  large  shots  in  Phase  I.  Open  circles 
denote  800  kg.  shots.  Solid  circles  are  200  kg  or  800  kg. 
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Locations  of  instrument  deployments  and  small  shots  in  Phase  I.  Small  shots 
alternating  2  kg  and  5  kg.  Figure  shows  location  of  every  10th  shot. 
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Locations  of  instrument  deployments  and  shots  for  Phase  II. 

Open  circles  are  200  kg,  except  3440  and  3441,  which  are  800  kg. 
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APPENDIX  C 


The  H.I.G.  Computing  Facility 


65 


The  HIG  computing  facility  equipment  is  supplied  by  Harris  Computer  Systems. 
The  hardware  either  installed  or  on  order  consists  of: 

Model  H800  CPU  with  Virtual  Memory  Access 
4096  Virtual  Memory  Paging  Registers 
(i.e.  4096k  bytes)  of  MOS  memory 
(3)  300  Megabyte  Disc  Modules 

(3)  Disc  Controllers  and  Channels 

(4)  Tape  Drives 

(3)  800/1600  BPI 
(1)  800  BPI 
(2)  Tape  controllers 
(56/  Terminal  Ports 
(1)  VERSATEC  Printer/Plotter 
(1)  SPINWRITER  Word  Processing  Printer 
(1)  Analog/Digital  Controller  and  Channel 

The  system  utilizes  the  VULCAN  Operating  System.  VULCAN  supports  time 
sharing  among  the  terminals  concurrent  with  the  execution  of  batch  jobs. 
VULCAN  also  includes  a  number  of  programming  languages.  These  include 
Fortran,  Cobol,  Pascal,  APL,  and  Basic  as  well  as  a  number  of  utilities  for 
sorting  and  editing  ot  both  text  and  data. 
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APPENDIX  D 

PROGRAM  LISTINGS 

Program  Page 

DISTAP .  69 

DVIEW .  72 

RECLEN .  73 

BIARCH .  74 

M<BIARC .  82 

HEDGEN .  84 

TAPOS .  86 

BHIROS .  88 

HRAMAC .  98 

ROSEHD .  100 

DISCAT .  102 

LISHDR .  106 

RDHDR .  108 

FIX .  109 

ROSED .  114 

ADHED .  119 

ADTAPE .  120 

DELHDR .  122 

DELTAP .  123 

BULLETIN .  124 

SEARCH .  126 

RECSEL .  128 

SELECT  129 

M<SEARCH .  136 

RETREV .  137 

M<RETREV .  140 

RARHIG .  242 

ITMCNT,  CNTITM,  ULCNT .  245 

Program  Notes  .  246 


1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 

61 

62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 


C  PROGRAM  DISTAP  TO  DISPLAY  CONTENTS  OF  ROSE  ARCHIVE  TAPE  HEADER 
C 

C  WRITTEN  BY  SHARON  LATRAILLE  LAST  UPDATED  6/24/82 

C  69 

NAME  DISTAP 

INTEGER  THBUF(224),TRAY(7),RDATE(3),JDATE(3) 

INTEGER  n>ATE(3),KDATE(3) ,DBUF(54), JBUF(260) , IS (5), IE (5) 

INTEGER  TAPE , DEPIMN , DEPEMX , DEPEMN , NBUF ( 3 ) 

INTEGER  ENUMMX , ENTMMN , EXPLMX , EXPLMN , ICHNMX 
INTEGER  ICHNMN ,  TYPE  MX, TYPEMN , EDEPMX , EDEPMN 
INTEGER  F(3,8),F1(3),F2(3),F3(3),F4(3),F5(3),F6(3),F7(3) 

INTEGER  F8(3) 

REAL  LLATMN , ILONMN 

DIMENSION  PLACE (5) ,DNAME (9 ) , EXCODE (4) , SHTLN( 10) 

INTEGER*6  CSEC , DSTMAX , DSTMIN , TDST , TDET 
INTEGER*1  ICRAY (162) , DCBUF ( 162) , NFBUF (9 ) 

EQUIVALENCE  (  JBUF ( 1 ) ,  ICRAY  ( 1 )  )  ,  (DBUF ,  DCBUF  )  ,  ( NBUF ,  NF*BUF ) 

EQUIVALENCE  (FI ,F) , (F2,F( 1 , 2 ) ) , (F3 , F( 1 , 3 ) ) , (F4 ,F( 1 ,4) ) 

EQUIVALENCE  (F5 ,F( 1 ,5 ) ) , (F6 , F( 1 ,6 ) ) , (F7 ,F(1 ,7 ) ) , (F8 , F( 1 , 8) ) 

EQUIVALENCE  (F9 ,F( 1 ,9 ) ) , (F10 , F( 1 , 10) ) , (Fll , F( 1 , 1 1 ) ) , (F12 , F( 1 , 1 2) ) 

COMMO N / IT CM /TRAY , CSE C , JULD 

DATA  FI/ '(IX,  18)  '/,F2/'(1X,  17)  '/ ,F3/'( IX, 16) '/ ,F4/'( IX, 15) 7 
DATA  F5/'(1X,I4)7,F6/'(1X,I3)'/,F7/'(1X,I2)'/,F8/'(1X,I1)7 
DATA  F9/'(I4)7,F10/'(I3)7,F11/'(I2)7,F12/'(I1)7 
DATA  TAPE/4/ 

C 

OPEN  TAPE 
NREC=0 
LOOP ( 1 ) 

.  WRITE(3, 1000) 

1000  .  FORMAT(lX, 'Enter  0  if  format  is  that  of  an  incoming  ROSE', 

+.  '  formatted  tape,  or',/  'Enter  1  if  tape  begins  with  an  HIG', 

'  Archive  header:') 

.  READ (0, )MTYPE 
.  IF(MTYPE,EQ.0) 

.  .  JDIS-0 

.  ,  WRITE(3 ,1002) 

1002  ,  ,  F0RMAT(1X, 'Display  first  80  words  of  "N"  headers.  Enter  N:', 

+.  .  /'  or,  optionally  display  5  words  of  all  headers.  Enter  0:') 

.  .  READ ( 0 , )  NWDS 

.  END  IF 

.  EXIT  LOOP  IF  (MTYPE.EQ.l) 

25  .  BUFFER  IN (TAPE, JBUF, B, 256 , ISTAT, IL) 

.  NREC-NREC+1 
.  CALL  STATUS (TAPE) 

.  IF( ISTAT. EQ. 3 )  GO  TO  25 
.  J»1 

,  FOR  1*1,162 
.  .  K*MOD(I,3 ) 

.  .  IF(K.NE.l) 

.  .  .  DCBUF(J)*ICRAY(I) 

.  .  .  J-J+l 

.  .  END  IF 

.  END  FOR 

C  DECODE  NUMBER  OF  FILES 
.  >1 
.  1-0 

.  FOR  K-108, 101,-1 
.  .  IF (DCBUF (K) ,NE. '  ') 

.  .  .  I-I+l 

.  .  .  IF(I.EQ.l) 

.  .  .  .  IP*J 

.  .  .  END  IF 

.  .  END  IF 

.  .  J*J+1 

.  END  FOR 

.  DECODE (9 ,F( 1 , IP ) ,DBUF(34) )  NFILES 
C 

C  DECODE  I ID 
.  J-l 
.  1*0 

.  FOR  K-4,1,-1 
.  .  IF (DCBUF (K) *NE.  '  ') 

.  .  .  1*1+1 

.  .  .  IF(I.EQ.l) 

.  .  .  .  IP-J+8 

.  .  .  END  IF 

.  .  END  IF 

.  .  J*J+1 

.  END  FOR 


81 

82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 

105 

106 

107 

108 

109 

110 

111 

112 

113 

114 

115 

116 

117 

118 

119 

120 

121 

122 

123 

124 

125 

126 

127 

128 

129 

130 

131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 

151 

152 

153 

154 

155 

156 

157 

158 

159 

160 


.  DECODE ( 4 ,  F  (1 ,  IP ) , DBUF )  IID 
C  DECODE(4,7999 ,DBUF)IID 
C7999  FORMAT ( 14 ) 

.  DECODE (55,8005, DBUF ( 2 ) )  DNAME 

8005  .  FORMAT (IX, 9 A6) 

.  DECODE (20, 8006, DBUF (21))  EXCODE 

8006  .  FORMAT (3A6,A2) 

.  DE CODE (12,8010, DBUF ( 27 ) )  (IS(I),I-1,5) 

8010  .  FORMAT ( 2X, 5 12 ) 

.  DECODE (10, 8020, DBUF (31))  ( IE ( I ) , 1-1 , 5 ) 

8020  .  FORMAT  (512) 

.  WRITE (3, 8040) IID, NFILES 

8040  .  FORMAT (IX ."INSTRUMENT  ID  ",I4 ,/,"  #  FILES  ",I4) 
.  VRITE(3,8045)  DNAME 

8045  .  FORMAT( IX, 'DESIGNER  NAME  &  ADDRESS:  ',9A6) 

.  WRITE (3, 8046)  EXCODE 

8046  .  FORMAT ( IX, 3A6 , A2 , '  EXPERIMENT') 

.  WRITE(3 ,8050)  IS 

8050  .  FORMAT ( IX, "START  TIME  ",5(1X,I2)) 

.  WRITE (3, 8060)  IE 

8060  .  FORMAT (IX, "END  TIME  ",5(1X,I2)) 

.  WRITE(  10, 8040)  IID,  NFILES 
.  WRITE (10,8045)  DNAME 
.  WRITE( 10 , 8046 )  EXCODE 
.  WRITE (10,8050)  IS 
.  WRITE( 1 0 , 8060)  IE 

C  DISPLAY  1ST  80  WORDS  OF  TEE  FIRST  FILE  HEADER  RECORD 
C  OR  DISPLAY  5  WORDS  OF  EACH  HEADER 
IF(NWDS.EQ.O) 

.  .  JDIS'l 

.  .  NWDS  =  NFILES 

END  IF 

.  LOOP ( NWDS ) 

•  .  DO 


BUFFER  IN  (TAPE, JBUF, B, 260, IFST.ILEN) 

.  NREC-NREC+1 

CALL  STATUS(TAPE) 

IF(IFST. EQ. 3 ) 

♦  ,  WRITE(3 ,7602) 

.  .  F0RMAT(1X, 'END  OF  FILE  ENCOUNTERED') 

END  IF 

EXIT  LOOP  IF ( IFST. GE. 4 ) 

UNT IL  ( IL  EN .  EQ .  2  56 ) 

CALL  CNVNEG( JBUF, 256) 

IF(JDIS.EQ.l) 

WRITE( 10 ,8301 )  JBUF(41 ) , JBUF ( 1 ) , JBUF ( 2) , JBUF ( 3 ) , JBUF(7 1 ) 

.  FORMATd  FILE  #:',I4,'  WORDS  1 ,2 ,3 ,7 1 :  '  ,418 ) 

ELSE 

.  FOR  II*=1 , 80 

.  .  WRITE(10 ,8300)  II,JBUF(II) 

.  .  FORMAT (IX, 'FILE  HEADER  WORD  #',I2,'  :  ',18) 

END  FOR 
END  IF 
ND  LOOP 
TE(3 , )  NR EC 
END  LOOP 
LOOP(l) 

.  EXIT  LOOP  IF(MTYPE.EQ.O) 

.  BUFFER  IN(TAPE,THBUF,B, 224, ISTAT.IL) 

.  CALL  STATUS (TAPE) 

.  DECODE (9 ,4000 ,THBUF )  ITAP 

4000  .  F0RMAT(3X,I6) 

.  DECODE (7 5 ,4001 ,THBUF(4) )  NSLN, (PLACE(I ) ,1-1,5), IDOC, 

+.  (RDATE(I ) ,1-1 ,3) , (IDATE(I) ,1-1,3), ( JDATE(I) ,1-1,3), 

+.  (KDATE(I), 1-1,3) 

4001  .  FORMAT(I6,5A6,13A3) 

.  DECODE(96 ,6000,THBUF(29 ) )  INUMMN , ENUMMX , ENUMMN.DSTMAX, 

+ .  DSTMIN , EXPLMX, EXPLMN , DEPIMN , DEPEMX, DEPEMN , 

+ .  IDEPMN , EDEPMX , EDEPMN , ICHNMX , ICHNMN , TYPE MX, TYPEMN 

6000  .  FORMAT ( 3 16 , 2 II 3 , 2 12 , 6 16 , 2 13 , 2 12 , 2X ) 

.  DECODE (102, 6001, THBUF(61))  SIZEMX, SIZEMN , RANG MX, RANG MN, 

+ .  XL  ATMN , ILONMN , ELATMX , ELATMN , ELONMX , ELONMN 

6001  .  FORMAT (10F10* 4, 2X) 

.  DECODE (174, 6002, THBUF(95))  IID, DNAME , EXCODE , NFILES , TDST, TDET, SHTLN 

6002  .  FORMAT (14 , 12A6 ,A2 ,16 , 114 ,1X, I14.1X, 1 0A6 ) 

.  DECODE (3 ,6003 ,THBUF(160) )  IDASH 

6003  .  FORMAT (13) 

.  WRITE(10,2001)  ITAP, IDASH 

2001  .  FORMAT (IX, 'ROSE  ARCHIVE  TAPE  NO. ' ,T40 , 16 , '-' , 13 ) 

.  IF(NSLN.EQ.l) 


7602 


8301 


8300 


I 

WR] 


16 
16 
16 
16 
16 
16 
167 
16 
169 
17  0 
17 

172 
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17  8 
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181 
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190 
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199 

200 
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207 
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209 
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211 
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213 

214 

215 

216 
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229 

230 
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232 

233 
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.  .  VRITE( 10,2002)  SHTLN(l) 

2002  .  .  FORMAT (IX, 'SHOT  LIME  NO.",T40,A6) 

.  END  IF 

.  IF(NSLN.GT.l) 

.  .  VRITE( 10,2050)  SHTLN 

2050  .  .  FORMAT (IX, 'SHOT  LINE  NOS.:  ",A6,9("  ",A6)) 

.  END  IF 

.  WRITE (10, 2003)  PLACE 

2003  .  FORMAT ( IX, " INSTITUTION  RECD  TAPE  FROM" , T40 , 5A6 ) 

.  WRITE( 10 , 2004)  IDOC 

2004  .  FORMAT( IX, "DOCUMENTATION  CODE;  1-YES " ,T40 , A3 ) 

.  WRITE( 10 ,2005)  RDATE 

2005  .  F0RMAT(1X, "DATE  ARCHIVE  TAPE  RECEIVED" ,T40 , 3 A3  ) 

.  WRITEOO  ,2006)  IDATE 

2006  .  FORMAT (IX, "DATE  ARCHIVED" ,T40 , 3A3 ) 

.  WRITE( 10 ,2007 )  JDATE 

2007  .  FORMAT ( IX , "DATE  LAST  UPDATED" ,T40 ,3 A3 ) 

.  WRITE( 10 ,2008)  KDATE 

2008  .  F0RMAT(1X, "DATE  LAST  ACCESSED" ,T40 ,3A3  ) 

.  WRITE(10 , 2009 ) 

2009  .  FORMAT (IX, '***+***++*++*  MINIMUM  &  MAXIMUM  VALUES  OF 
+.  "KEYWORDS  »★****★★*****") 

.  WRITE( 10 ,2010)  INUMMN 

2010  .  F0RMAT(1X, "INSTRUMENT  NUMBER" ,T40 , 16) 

.  WRITE(10 ,201 1 )  ENUMMN , ENUMMX 

2011  .  FORMAT (IX, "EVENT  NUMBERS" ,T40 , 216 ) 

.  CSEC-DSTMIN 

.  CALL  CNTITM 
.  WRITE(10,2012)  TRAY 

2012  .  FORMAT (IX, "MINIMUM  DATA  START  TIME" ,T40 ,7 14 ) 

.  CSEC-DSTMAX 

.  CALL  CNTITM 
.  WRITE(10,2013)  TRAY 

2013  .  F0RMAT(1X, "MAXIMUM  DATA  START  TIME" , T40 ,7 14 ) 

.  WRITEdO  ,2014)  EXPLMN  ,  EXPLMX 

2014  .  FORMAT (IX, "EXPLOSIVE  TYPES" ,T40 , 212 ) 

.  WRITEdO, 2015)  DEPIMN 

2015  .  FORMAT (IX, "WATER  DEPTH  AT  INSTRUMENT" , T40 , 16 ) 

.  WRITEdO, 2016)  DEPEMN  ,DEPEMX 

2016  .  FORMAT (IX, "WATER  DEPTHS  AT  EVENT" ,T40 ,216) 

.  WRITEdO, 2017)  IDEPMN 

2017  .  FORMAT (IX, "INSTRUMENT  DEPTH" ,T40 , 16) 

.  WRITEdO, 2018)  EDEPMN , EDEPMX 

2018  .  FORMATdX,  "EVENT  DEPTHS"  ,T40 ,216) 

.  WRITEdO, 2019)  ICHNMN ,  ICHNMX 

2019  .  FORMATdX,  "#S  OF  CHANNELS"  ,T40 ,213 ) 

.  WRITEdO, 2020)  TYPEMN  ,  TYPE  MX 

2020  .  FORMATdX,  "EVENTS  TYPES"  ,T40 ,212 ) 

.  WRITEdO, 2021)  SIZEMN ,  SIZEMX 

2021  .  FORMATdX,  "EVENT  SIZES  "  ,T40 ,2F10 .4) 

.  WRITEdO, 2022)  RANGMN ,  RANG  MX 

2022  .  FORMATdX,  "RANGES', T40,2F10. 4) 

.  WRITEdO, 2023)  ILATMN 

2023  .  FORMATdX,  "INSTRUMENT  LATITUDE"  ,T40  ,F1 0.4) 

.  WRITEdO, 2024)  ILONMN 

2024  .  FORMATdX,  "INSTRUMENT  LONGITUDE' ,T40  , FI 0.4) 

.  WRITE (10, 2025)  ELATMN , ELATMX 

2025  .  FORMATdX,  "EVENT  LATITUDE  RANGE' ,T40 , 2F10 .4) 

.  WRITE (10, 2026)  ELONMN , ELONMX 

2026  .  FORMATdX,  "EVENT  LONGITUDE  RANGE"  ,T40 ,2F10.4 ) 

.  WRITEdO, 2027  ) 

2027  .  FORMAT ( IX, "★**★*  TAPE  HEADER  FILE  CONTENTS  **♦**') 

.  WRITEdO, 2028)  IID.DNAME 

2028  .  FORMATdX,  "INSTR.  *',T20,I4,"  DESIGNER' ,T40 ,9  A6 ) 

.  WRITEdO, 2029)  EXCODE, NFILES 

2029  .  FORMATdX,  "EXPERIMENT:  ",T20,3A6,A2,"  #  OF  EVENTS:", 

+  .  T6  0 , 16 ) 

.  CSEC-TDST 
.  CALL  CNTITM 
.  WRITEdO, 2030)  TRAY 

2030  .  FORMATdX,  "TAPE  DATA  START  TIME' ,T40,7I4) 

.  CSEC-TDET 

.  CALL  CNTITM 
.  WRITEdO, 2031)  TRAY 

2031  .  FORMATdX,  "TAPE  DATA  END  TIME' ,T40,7I4) 

END  LOOP 

STOP  POO 
END 
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HAKE  DVIEW 

INTEGER  IBUF(4096) ,JBUF(4096) 

IKC-1 

IREC-0 

NF-1 

C  PROCESS  TAPE  HEADER  FILE 
LOOP (2) 

.  BUFFER  IN(4,IBUF,B,256,IS,IL) 

•  CALL  STATU S( 4) 

.  IREC-IREC+1 
.  VRITE(10,1001)  IREC.IL 

1001  .  FORMATS  RECORD  NO.  ",16/  LENGTH' ,16) 

.  EXIT  LOOP  IF(IS.EQ.3) 

.  VRITE( 10 ,1000)  ( IBUF ( J ) , J- 1 , 54 ) 

1000  .  FORMAT (27 A3 ) 

END  LOOP 
WRITE(3 ,100) 

100  FORMAT('  enter  no.  of  files  to  look  at') 

READ( 0, )  NFILES 
WRITE(3 , 200) 

200  FORMAT ( '  ENTER  COMPONENT  NUMBER  TO  DISPLAY:') 

READ( 0, )  IK 
LOOP(NFHES) 

DO 

BUFFER  D?(4, IBUF, B, 4096, IS, H) 

CALL  STATU S( 4) 

IREC-IREC+1 

WRITE( 10,1001 )  IREC, IL 
IF(IL.EQ.O) 

.  NF-NF+1 
END  IF 

UNTILCIL.EQ.256) 

NREC-IBUF  (71) 

NCOMP-  IBUF  ( 39  ) 

IF(IBUF(1) .LE.99 )  NCOMP-2 
LOOP 

EXIT  LOOP  IF(IKC.EQ.IK) 

LOOP(NREC) 

.  BUFFER  IN(4, JBUF, B,4096 , IS, IL) 

END  LOOP 
IKC-IKC+1 
END  LOOP 

WRITE( 10 ,300)  NF, TBUF(3) , IK 
300  .  FORMAT('  FILE  NO. ',16,'  EVENT  NO. ',16,'  COMPONENT  NO. 

LOOP (NREC ) 

BUFFER  IN(4, IBUF, B,4096 , IS ,  IL) 

CALL  STATUSC4) 

IREC-IREC+1 

WRITE( 10 , 1 001 )  IREC, IL 
CALL  CNVNEG( IBUF, 409 6) 

FOR  L-1,51 
.  LL»80*(L-1 )  +  1 

.  WRITEOO ,2001 )  ( IBUF ( I )  , I-LL , LL+7 9 ) 

2001  .  .  .  FORMAT ( 10( /8I10) ) 

END  FOR 

WRITE ( 1 0 , M ( / 218 ) " )  (IBUF(I), 1-4081, 4096) 

END  LOOP 
IKC-1 
END  LOOP 
STOP 
END 


NAME  RECLEN 
INTEGER  JBD7( 11000) 

1-0 

ltF-1  73 

WRITE(3,"('  ENTER  #  FILES')") 

READ  (0,)  NFILES 
LOOP 

.  BUFFER  IN(4,JBUF,B, 11000, IS, IL) 

.  CALL  STATUS(A) 

.  I-I+l 

.  EXIT  LOOP  IF(IS. GE.4) 

.  WRITE(3,"('  FILE  NO.  ',14,'  RECNO, LENGTH' ,216)" )  NF,I,IL 

.  IF(IL.EQ.O) 

.  .  NF-NF+1 

.  .  WRITE ( 3 , " C '  ')") 

.  END  IF 

.  IF(IL.EQ.256)  WRITE(10,"('  EVERT  HO.', 16)")  JBUF(3) 

.  IF(NF.GT. NFILES)  GOTO  999 
END  LOOP 

WRITE(3,"('  NO.  OF  EOFS',15)")  RF 

STOP 

STOP  NF 

END 
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C  PROGRAM  B  I  A  R  C  H  TO  READ  AND  REWRITE  ROSE  FORMATTED  SEISMIC  DATA 
C  FROM  TAPE  AND  TO  ADD  TO  TEE  ARCHIVE  CATALOG  AREA. 

C 

C  WRITTEN  BY  SHARON  LATRAILLE  HIG  363  X7796 
C  LAST  UPDATED  3/30/83  (REV  7) 

C  TO  RUN  USE  MACRO  M<BLARC  ;TO  COMPILE  USE  J.B LARCH 

C 

C 


NAME  BIARCH 

INTEGER  IC(24), R£RR,ELOER, BUB, SAMP, FNUM,INUM,ENUM 
INTEG  ER  WDEP I ,  VDEPE ,  IDEP ,  EDEP ,  ICHN , CCODE ,  HDLFN 
INTEGER  CATBUF(224) ,FEDR(260) , IBUF(4096) ,DBUF(54) 

INTEGER  RDATE  (3) ,  IDATE( 3)  ,  IDATl  (3)  ,EXPL,TYPE,MBUF(224) 
INTEGER  CATLFN ,  TAPE ,  OUTF ,  DEPIMX ,  DE? IMN  >  DEPEMX ,  DEPEMN 
INTEGER  ENUMMX , ENUMMN , EXPLMX, EXPLMN , ICHNMX 
INTEGER  ICHNMN , TYPE  MX , TYPEKN , EDEP MX , EDEPMN , REP 
INTEGER  THBUF(224) , TRAY 1(7 ) , TRAY (7) , ITIME(3) 

INTEGER  SBEG( 10) , SEND( 10) 

REAL  ILAT,  XL  ON,  ILATMX, LLATMN , ILONMX, ILONMN 
INTEG  ER*1  ICRAY (162) ,DCBUF( 162) 

INTEGERS  SBT,CSEC,DST,DSTMAX,DSTMIN,TDST,TDET, ISTATS(2) 
DIMENSION  PLACE( 5) ,  DRAKE (9 ) , EXCODE (4) 

DIMENSION  C(8) ,COMBUF(24) ,SHTLN(10) ,A(4) 

EQUIVALENCE  (IBUF(  1 )  ,  ICRAY(l)  )  ,  (DBUF ,  DCBU7  ) 


C 


EQUIVALENCE  (CATBUP(l) , JTYPE ) ,(  CATBUF  (2) , ITAP) , (CATBUF(3) , INUM) 
EQUIVALENCE  (CATBUF(4) ,ENUM) , (CATBUF(5) ,DST) , (CATBUF(7 ) , SBT) 
EQUIVALENCE  (CATBUF(9 ), SIZE) , (CATBUF ( 11 ), RANGE) 

EQUIVALENCE  (CATBUF(13)  ,  HAT ) ,  (CATBUF  ( 15) ,  ILON ) ,  (CATBUF ( 17  )  , ELAT ) 
EQUIVALENCE  (CATBUF(19 ) , ELON ) , ( CATBUF ( 21 ) ,EXPL) , (CATBUF (22) ,WDEPI) 
EQUIVALENCE  (CATBUF (23) ,VDE?E ) , ( CATBUF ( 24) , IDEP ) , (CATBUF (25) ,EDEP ) 
EQUIVALENCE  (CATBUF(26)  ,ICHN)  ,( CATBUF (27  )  ,TYPE) 

EQUIVALENCE  (CATBUF ( 28 )  ,RERR) ,  (CATBUF (29  )  .ELOER) ,  (CATBUF (30)  ,  BUB) 
EQUIVALENCE  (CATBUF (31)  , SAMP) , (CATBUF (32)  ,NWDS) 

EQUIVALENCE  (CATBUF(33) ,FNUM) ,  (CATBUF  (34 ) , NREC ),( CATBUF (35 ) ,NSAM) 
EQUIVALENCE  (CATBUF  (36)  ,  ID  EL)  ,  (CATBUF  (37  )  ,  IDATE  ) 

EQUIVALENCE  (CATBUF (40)  ,  IDATl  )  ,  (CATBUF (43)  ,IC) 

EQUIVALENCE  (CATBUF (67  )  ,  SHTLIN)  ,  (CATBUF (69  )  ,  CCODE  ) 

COMMON / ITCM/TRAY , CSEC , JULD 
COMMON /AVG/  IB UF, MEAN 

DATA  TAPE/4/lOUTF/20/,CATLFN/30/>HDLFN/40/,C(l)/'r/,C(2)/"R"/> 
+C(3)/'T'/,C(4)/'P'/,C(5)/'H1'/,C(6)/'R2'/,C(7)/'V'/,C(8)/'TI'/, 


+REP/10/ 

CALL  BTIME 
CALL  DATE (IDATE) 

CALL  TIME (ITIME ) 

FOR  1-1,3 

.  IDATKI)-IDATE(I) 

END  FOR 
OPEN  OUTF 
OPEN  CATLFN 
OPEN  TAPE 

C  FIND  POSITION  OF  START  OF  TAPE  HEADERS  IN  CATALOG 
CALL  DPO  S ( CATLFN , 2 ) 

CALL  BUF IN ( CATLFN ,MBUF,112,IEOF) 

ITHEAD-MBUF (112) 

C  ZERO  IC  ARRAY  AND  SHTLN  ARRAY 
FOR  1-1,24 
.  IC(I)-0 

END  FOR 
FOR  1-1,10 
.  SHTLN(I)-"  " 

END  FOR 


C 

VRITE(3 ,7950) 

7950  FORMAT (IX /Program  ARCHIVE,  REV.  6,  Laat  modified  5/4/82', 
+/'  ★*  CHECK  SOURCE  IF  HAVE  MIXTURE  OF  SHOTS  6  QUAKES') 


C 

C  Read  HIG  header  information 

READ (HDLFN, 8000)  ITAP, IDSH, IID1 ,NSLN 

8000  FORMAT(T50 , 13  ,  /T50 ,  X3 ,  /T50 , 15 ,  /T50 , 13  ) 

FOE  J-l.NSLN 

.  READ (HDLFN, 8001)  SHTLN( J) ,SBEG( J) ,SEND( J) 

8001  .  FORMAT(T50,A6,2I5) 

END  FOR 
IEVST-SBEG(l) 

READ(HDLFN,8002)  PLACE , IDOC , RDATE 

8002  FORMAT (T50 ,5A6 , /T50.I3 , /T50.3A3) 

READ(HDLFN, 8003)  ERA, IDSH1 , IKK 

8003  FORMAT (T50, 13 ,2(/T50,I3)) 
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IF(IKK.NE.O) 

•  READ(HDLFN , 8004)  KDC , IOVRD , JTC 

8004  .  FORMAT(T50,I3,/T50,I4,/T50,I3) 

.  IF( JTC.EQ. 1 ) 

.  •  READ (HDLFN, 8022)  TDST, TDET 

8022  .  .  F0RMAT( 2114) 

.  END  IF 
END  IF 

C  ENCODE  BIG  HEADER  INFO  INTO  TAPE  HEAD  BUFFER 
J TYPE- 2 

ENCODE ( 84  ,7  500 ,THBUF )  JTYPE ,  ITAP,  RSLN,  (PLACE (I )  ,  I-l , 
+(RDATE(I )  ,1-1,3),  (IDATE(I)  ,  1-1 ,3 )  ,  ( IDATE( I ) ,  I-l  ,3 ) , 
+( IDATE ( I ) , I-l , 3 ) 

7500  FORMAT ( 13 ,216 ,5  A6 , 13A3  ) 

ENCODE(3 ,7 501 ,THBUF( 160) )  IDSH 

7501  FORMAT ( 13 ) 

C  *■+»■**■*•**««  BEGIN  TAPE  PROCESSING  ******************* 

C 

BUFFER  IN (TAPE , IBUF, B, 256 , ISTAT, ILEN ) 

CALL  STATUS  (TAPE) 

IF  (ISTAT. EQ. 3) 

.  WRITE(3 ,7601 ) 

7601  .  FORMAT ( IX, 'EOF  ON  INITIAL  TAPE  HEADER  READ") 

END  IF 

C  WRITE  TAPE  HEADER  FILE  TO  ARCHIVE  FILE 
C 

BUFFER  CXJT  (OUTF,  IBUF,  B,  256  ,  ISTAT,  ELEN) 

ENDFUE  OUTF 
J-l 

FOR  1-1,162 
.  K-MOD(I , 3 ) 

.  IF(K.NE.l) 

.  .  DCBUF(J)-ICRAYd) 

.  .  J-J+l 

•  END  IF 
END  FOR 

C  DECODE  TAPE  HEADER 
C 

C  DECODE  NUMBER  OF  FILES 
XCHAN-0 

40  DECODE (9 , " ( BN, 19 ) " , DBUF ( 34) )  NFILES 
C  DECODE  I ID 

DECODE (4, "(BN, 14)" ,DBUF )  IID 
DECODE(55 ,8005 ,DBUF(2) )  DNAME 

8005  FORMAT  (IX,  9  A6) 

DECODE (20 ,8006, DBUF (21))  EXCODE 

8006  FORMAT ( 3 A6,A2) 

DECODE (12,8010, DBUF ( 27 ) ) IS YR, ISMO , ISDA, ISHR, ISMIN 
8010  FORMAT (2X, 5 12) 

DECODE ( 1 0 , 8020 , DBUF ( 3 1 )) IFYR , IFMO , IFDA , IFHR , IFM IN 
8020  FORMAT  (512) 

VRITE(3 ,8040)  IID, NFILES 

8040  FORMAT( IX, "INSTRUMENT  ID  ",I4,/,"  #  FILES  *,I4) 

IF( IOVRD. NE.O) 

.  NFILES- IOVRD 
.  VRITE(3 ,8041 )  NFILES 
8041  •  FORMAT('  NO.  FILES  SET  TO:  ',16) 

END  IF 

WRITE(3 ,8045 )  DNAME 

8045  FORMAT( IX, 'DESIGNER  NAME  &  ADDRESS:  ',9A6) 

WRITE (3, 8046)  EXCODE 

8046  FORMAT ( IX , 3 A6 , A2 , '  EXPERIMENT') 

WRITE(3 ,8050)ISYR,  ISMD ,  ISDA,  ISHR,  ISMIN 

8050  FORMAT ( IX, "START  TIME  M,5(1X,I2)) 

WRITE(3, 8060)  IFYR,  IFMO,  IFDA,  IFHR,  IFM  IN 
8060  FORMAT (IX, "END  TIME  ",5(1X,I2)) 

TRAY ( 1 )-ISYR 
TRAY(2)-ISM0 
TRAY(3)-ISDA 
TRAY(4)-ISHR 
TRAY(5)-ISMIN 
TRAY(6)-0 
TRAY  (7  )-0 
CALL  ITMCNT 
TDST-CSEC 
TRAY( 1 )-IFYR 
TRAY ( 2)-IFMO 
TRAY(3)-IFDA 
TRAY (4) -IFHR 
TRAY ( 5 ) - IFM  IN 
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CALL  ITMCNT 
TDET-CSEC 

C  Encode  tape  header  info  into  current  HIG  tape  header  buffer 
C 

ENCODE ( 17  4,7  600  ,THBUF(95  ) )  I ID, DNAME , EXCODE , NFILES , TDST, TDET, SHTLN 
7600  FORMAT ( 14, 12A6 ,A2 , 16 , 114, IX, II 4, IX, 10A6 ) 

C 

C  SAVE  OFF  TAPE  HEADER  RECORDS 
C 

IKE XT- ITHRAD 

CALL  DPOS( CATLFN, INEXT ) 

LOOP 

ISAV-0 

CALL  BU F IN (CATLFN, MB UF , 224, EEOF ) 

.  EXIT  LOOP  IF ( IEOF . GE. 3 ) 

C  IF  REARCHIVING,  DONT  SAVE  TAPE  HEADER  RECORD  FOR  THIS  TAPE 
IF(KRA.EQ.l) 

DECODE (9 ,7  550 ,MBUF )  KTAP 

7550  .  .  FORMAT (3X, 16) 

DECODE (6 ,7  553  ,THBUF(95 ) )  INM 

7553  .  .  FORMAT ( 14 ,2X) 

DECODE (3 ,7  501 ,MBUF(160) )  IDASH 
DECODE (6 ,7  551  ,MBUF ( 121 ) )  NF 

7551  .  .  FORMAT (16) 

IF(KTAP.EQ.ITAP) 

IF(IDSHl .EQ. IDASH.  AND.  NFILES.  EQ.NF.  AND. IID.EQ. INM) 

.  WRITE (3,7552)  ITAP ,  IDSHl ,  HD,  NFILES ,  KTAP ,  IDASH ,  INM,  NF 
7552  ....  FORMAT ( IX, '  Input  tape , instrument , #f iles :', 16 /-', 12 , 2 

I'  catalog  file  tape , instrument ,#f iles 16, 12 ,216) 

WRITE(3 ,7  555) 

7555  ....  FORMAT ( '  We  have  a  match ; Execute  replacement  ARCHIVE  , 

'  after  saving  remaining  headers') 

INEXT- MB  UF  (153  ) 

ISAV-1 
END  IF 
END  IF 
END  IF 

IF(ISAV.EQ.O) 

.  BUFFER  OUT ( 11 ,MBUF, B, 224,MSTAT,MLEN) 

.  CALL  STATU S( 11) 

END  IF 
END  LOOP 
REWIND  11 
TRBUF(153)-INEXT 
CALL  DPOS( CATLFN, INEXT) 

WRITE(3 , 1050)  t 

FORMAT  (/1X/B  eg  in  reading  and  writing  event  header  records  ) 


C  READ/WRITE  FILE  HEADER  RECORDS  AND  DATA 
C 

JTYPE-1 

1-0 

IQ-0 

LOOP  (NFILES) 

I-I+l 
DO 

BUFFER  IN  (  TAPE ,  PHDR ,  B ,  26  0 ,  IFST ,  ILEN  ) 
CALL  STATUS  (TAPE) 

IF(IFST.EQ.3) 

.  WRITE(3 ,7  602) 

7602  .  .  .  FORMAT (IX, 'EOF  ENCOUNTERED') 

END  IF 

EXIT  LOOP  IF(IFST.GE,4) 

UNTIL  ( ILEN.  EQ.  256  ) 

CALL  CNVNEG(FHDR, 256) 

BUFFER  OUT(OUTF,FHDR,B, 256, 1ST, ILEN) 

CALL  STATUS  (OUTF) 

FOR  J-1,7 

.  TRAY(j)-FHDR(J+3) 

END  FOR 
CALL  ITMCNT 
INUM  -FHDR(l) 

ENUM  -FHDR(3) 

DST  -CSEC 

SIZE  -(10.**(FHDR(36)/1000.))/1000. 
IF(FHDR( 2) .EQ. 1 ) 

.  SIZE  -FLOAT(FHDR(36))/10. 

END  IF 

ISIZE-IFIX(SIZE) 
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.  RANGE  "FLOAT (FHDR( 11 ) )*1000.+FLOAT(FHDR(12)) 

+  .  +FLOAT(FHDR(13))/1000. 

.  A(1 ) "FLOAT (FHDR( 16 ) ) /1Q00. 

.  A(2)-FLOAT(FHDR(18))/1000.  77 

.  A(3 ) "FLOAT (FHDR( 22) )/1000. 

.  A(4)-FLQAT(FHDR( 24) ) /1000. 

.  ILAT  -ISIGN( 1 ,FHDR( 15) )*(ABS (FLOAT (FHDR( 15) ) )+ABS(A ( 1 ) ) ) 

.  ILON  -ISIGRC 1 , FHDR( 17 ) )*(AB S( FLOAT (FHDR( 17 ) ) )+ABS(A( 2) ) ) 

.  ELAT  -ISIGN( 1,FHDR( 21 ) ) *(ABS (FLOAT (FHDR( 21 ) ) )+ABS(A(3) ) ) 

.  ELON  -ISIGN(  1  , FHDR(  23  )  )*  (ABS(  FLOAT  (FHDR(  23  )  )  )+ABS(A(4)  )  ) 

•  IF(RANGE.LT.0 .0)  CALL  RANG ER( ILAT, ILON, ELAT, EL ON, RANGE) 

.  EXPL  "FHDR( 35) 

.  WDEPI  *FHDR( 20) 

.  WDEPE  -FHDR( 27 ) 

.  LDEP  -FEDR( 19 ) 

.  EDEP  *FHDR( 26 ) 

.  ICHN  *FHDR( 39 ) 

.  IF(KCRAN.NE.O)  ICHN-KCRAN 
.  CCODE-FBDR(60) 

•  IF(ICHN. GT. 10) 

.  •  C CODE-1 

.  END  IF 
.  TYPE  -FHDR( 2) 

.  IF(FHDR( 28) . GT. 0) 

.  .  FOR  J-1,7 

.  .  .  TRAY( J)“FHDR( J+27 ) 

.  .  END  FOR 

.  .  CALL  ITHCNT 

•  .  SBT-CSEC 
.  ELSE 

.  .  SBT-DST 

.  END  IF 
,  RERR-FHDR(14) 

•  ELOER"FHDR( 25 ) 

.  BUB-FRDR( 37 ) 

.  SAMP-FHDRC38) 

•  NWDS-FHDR(40) 

.  FNUM»FHDR( 41 ) 

.  NREC-FHDR(71) 

•  NSAM-FHDR(72) 

.  IDEL-0 

.  FOR  JK-1 , NSLN 

.  .  IF(ENUM. GE. SBEG( JK) .AND. ENUH.LE. SEND( JK) ) 

•  .  .  SETLIN-SHTLN(JK) 

.  .  END  IF 

.  END  FOR 

C  FOR  LESS  THAN  11  CHANNELS 
.  IF(ICHN.LT. 11) 

.  .  FOR  K*1 , ICHN 

.  .  .  IC ( K ) "FHDR ( 41 +K*20 ) 

.  .  END  FOR 

.  END  IF 

C  FOR  MORE  THAN  11  CHANNELS 
.  IF (ICHN.GE.il) 

.  .  IP(CCODE.EQ.O) 

.  .  ,  HEAD" (FLOAT (ICHN) -10 . )/12. 

.  .  .  NHDRS»IFLX(HEAD) 

.  .  .  IF ( HEAD-FLOAT (NHDRS) , GT.O .0) 

.  .  .  .  NHDRS-NHDRS+1 

.  .  .  END  IF 

.  .  .  FOR  K-1,10 

.  .  .  .  IC (K)"FHDR( 41 +K*20 ) 

.  .  .  END  FOR 

.  .  .  FOR  IH-1, NHDRS 

....  DO 

. BUFFER  D?(TAPE,FHDR,B>260,IFST>  HEN) 

.  CALL  STATUS (TAPE) 

.  .  .  .  UNTIL(  ILEN.  EQ.  256 ) 

.  .  .  .  CALL  CNVNEG( FHDR ,256) 

.  .  .  .  BUFFER  CUT(OUTF, FHDR, B, 256 , 1ST,  ELEN ) 

.  .  .  .  L*10*IH+IB 

.  .  .  .  LL-L+12 

.  .  .  .  FOR  K-L,LL 

.  IC ( L) -FHDR( l+( IH-1 )*20) 

.  ...  END  FOR 

.  .  .  END  FOR 

.  .  END  IF 

.  .  IF(CCODE.EQ.l) 

.  .  .  IC(1)-FHDR(61) 

.  .  END  IF 
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.  END  IF 

C  WRITE  VARIABLES,  INCLUDING  KEYWORDS,  TO  CATBUF 
C 

.  CALL  BUFOUT(CATLFN ,  CATBUF,  1 1 2 ,  IE  OF ) 

.  CALL  DSTAT(CATLFN, ISTATS, ICRA) 

C  INITIALIZE  MIN, MAX  VALUES  OF  KEYWORDS 
C  CHECK  FOR  QUAKES 
C 

.  IF  (TYPE.  EQ.  1 ) 

.  .  I-I-l 

.  .  IQ-IQ+1 

.  .  GO  TO  777 

.  END  IF 
.  IF(I.EQ. 1 ) 

.  .  INUMMX-INUM 

.  .  INUMMN-INUM 

•  *  ENUMMX-ENUM 

.  .  ENUMMN-ENUM 

.  .  DSTMAX-DST 

.  .  DSTMIN-DST 

.  .  EXP  L  MX*  EXP  L 

.  .  EXPLMN-EXPL 

.  .  DEPIMX«WDEPI 

.  .  DEPIMN-WDEPI 

.  .  DEPEMX-WDEPE 

.  .  DEPEMN-VDEPE 

.  .  IDEPMX-IDEP 

.  .  IDEPMN*IDEP 

.  .  EDEPMX*EDEP 

.  .  EDEPMN-EDEP 

.  .  ICHNMX-ICHN 

.  .  ICHNMN-ICHN 

.  .  TYPEMX-TYPE 

.  •  TYPEMN'TYPE 

.  .  SIZEMX-SI2E 

.  *  SIZEMN*SIZE 

.  .  RANGMX -RANGE 

.  .  RANG KN- RANGE 

.  .  ILATMX*ILAT 

.  .  ILATMN*  HAT 

,  .  ILONMX-ILON 

.  .  ILONMN*ILON 

•  .  ELATMX*ELAT 

.  .  ELATMN-ELAT 

.  .  ELONMX-ELON 

.  .  ELONMN-ELON 

.  END  IF 

C  NOW  COMPARE  NEW  VALUES  OF  KEYWORDS  WITH  MIN, MAX  AND  GET  NEW  MIN, MAX 
C 

.  INUMMX*MAXO(  INUMMX,  INUM) 

.  INUMMN-MINO(INUMMN,INUM) 

.  ENUMMX*MAXO(ENUMMX,  ENUM) 

.  ENUMMN*MINO(ENUMMN,ENUM) 

.  DSTMAX-MAX2(DSTMAX,DST) 

.  DSTMIN-MIN2 (DSTMIN , DST ) 

.  EXPLMX-MAXO(EXPLMX,EXPL) 

.  EXPLMN-MINO ( EXPLMN , EXPL ) 

.  DEPIMX*MAXO(DEPIMX, WDEPI) 

•  DEP IMN-MINO (DEP IMN , WDEP I ) 

.  DEPE  MX-MAXO  (  DEPEMX ,  WDEPE  ) 

.  DEPE MN*MINO(DEPEMN, WDEPE ) 

.  ID EP MX-MAXO ( IDEPMX , IDEP ) 

.  IDEP MN * MIN 0 ( IDEPMN , IDEP ) 

.  EDEPMX-MAXO(EDEPMX, EDEP ) 

.  EDEPMN-MINO (EDEPMN , EDEP ) 

.  ICHNMX-MAXO(ICHNMX, ICHN) 

.  ICHNMN-MINO( ICHNMN , ICHN) 

•  TYPE  MX-MAXO  (TYPEMX,  TYPE ) 

.  TYPEMN-MINO(TYPEMN,TYPE) 

.  SIZEMX-AMAX1  ( SIZEMX,  SIZE) 

.  SIZEMN-AMINl  (  SIZEMN ,  SIZE) 

•  RANGMX-AMAXl  (RANGMX,  RANGE) 

.  RANGMN-AMINl  (  RANGMN ,  RANGE) 

.  ILATMX  - AMAX 1  ( ILATMX ,  HAT  ) 

•  ILATMN- AMIN  1  ( ILATMN ,  HAT ) 

.  HONKX-AMAX1  ( ILONMX ,  HON ) 

.  ILONMN-AMINl  (ILONMN,  ILON) 

.  EL ATMX- AMAX 1 (ELATKX, ELAT ) 

.  ELATMN-AMINl  (ELATMN,ELAT ) 

.  ELONMX-AMAXl  (ELONMX,  ELON  ) 


401 

402 

403 

404 

403 

406 

407 

408 

409 

410 

411 

412 

413 

414 

415 

416 

417 

418 

419 

420 

421 

422 

423 

424 

425 

426 

427 

428 

429 

430 

431 

432 

433 

434 

435 

436 

437 

438 

439 

440 

441 

442 

443 

444 

445 

446 

447 

448 

449 

450 

451 

452 

453 

454 

455 

456 

457 

458 

459 

460 

461 

462 

463 

464 

465 

466 

467 

468 

469 

470 

471 

47  2 

473 

474 

47  5 

476 

477 

47  8 

479 

480 


.  ELONKN-AMIKl  (ELONMN,  ELON) 

C  COPY  DATA  RECORDS  TO  DISC  FILE 
777  .  1WCHN*NREC 

.  NTAL-N  79 

.  WRITE(3 ,41 12)  KFUH,FHUM 

4112  .  FORMAT (IX,  "PROCESSING  EVENT  NO.  ',16/  FILE  NO.  ',16) 

.  NIN-0 
.  ILOOP-O 
.  LOOP (N) 

.  .  BUFFER  IN  (TAPE,  IB 07,  B, 4096 , 1ST,  HEN) 

.  .  GALL  STATUS  (TAPE) 

.  .  CALL  CNVNEG( IBUF, 4096 ) 

.  .  NTAL-NTAL-1 

C  NOW  TAKE  OUT  DC  OFFSET 
.  .  IF(KDC.EQ.l) 

.  .  .  HOOP-ILOOP+1 

.  .  .  IRNO“l+NIN*NREC 

.  .  .  IF(ILOOP.EQ.IRNO) 

.  .  .  .  CALL  AVER 

.  .  .  .  NIN-NIN+1 

.  .  .  END  IF 

.  .  .  FOR  J-1,4096 

.  .  .  .  IBUF(J)-IBTJF(J)-MEAN 

.  .  .  END  FOR 

.  .  END  IF 

.  .  BUFFER  OUT(OUTF,  IBUF, B, 4096, ISTAT,  HEN) 

.  END  LOOP 
.  IF(NTAL.NE.O) 

.  .  WRITE (3, I 123)  ENUM.N.NTAL 

1123  .  .  FORMATC'  EVENT', 16,'  WITH', 16,'  RECORDS  TO  PROCESS  WAS  SHORT', 

+.  •  ',16,'  RECORDS') 

.  END  IF 
.  ENDFILE  00 TF 
END  LOOP 
ENDFILE  OUTF 

C  ADD  TAPE  HEADER  RECORDS  BACK  ON  TO  EVENT  CATALOG 
C 

CALL  DSTAT(CATLFN, ISTATS , ICRA) 

IF(KRA.EQ.l) 

.  CALL  DPOS(CATLFN,ITHEAD) 

END  IF 
LOOP 

.  BUFFER  IN(11,MBUF,B,224,MSTAT,MLEN) 

.  CALL  STATU  S ( 1 1 ) 

.  EXIT  LOOP  IF(MSTAT.GE.3) 

.  CALL  BUFOUT(CATLFN,MBUF,224,  IEOF ) 

END  LOOP 

CALL  DS  TAT  ( CATLFN ,  ISTATS ,  HAS  T  ) 

IF(KRA.NE.l) 

.  CALL  DP0S( CATLFN, 2) 

.  CALL  BUFIN( CATLFN, MB UF, 112, IEOF) 

.  KBUF(112)-ICRA 
.  CALL  DPOS( CATLFN, 2) 

.  CALL  BUFOUT ( CATLFN ,MBUF, 112, IEOF) 

.  WRITE (3, 11 21)  ICRA 

1121  .  FORMATC IX, 'START  RECORD  FOR  TAPE  HEADERS  NOW: ',16) 

END  IF 

C  CHECK  FOR  INSTRUMENT  KEYWORD  VALUE  MISMATCHES 
IF  ( ILATMX .  NE .  HATMN ) 

.  WRITE(3,2000) 

2000  .  FORMAT (IX, 'INST.  LATITUDES  ENCODED  HOT  EQUAL  FOR  ALL  EVENTS') 

END  IF 

IFCINUMMN.NE. INUMMX) 

.  WRITE(3,2001) 

2001  .  FORMAT (IX, 'INST  *  ENCODED  NOT  EQUAL  FOR  ALL  EVENTS') 

END  IF 

IF(DEPIHN.NE.DEPIMX) 

.  WRITE(3 ,2002) 

2002  .  FORMAT (IX, 'WATER  DEPTHS  AT  INST  NOT  SAME  FOR  ALL  EVENTS') 

END  IF 

IF ( IDEPMN . NE. IDEPMX ) 

.  WRITE(3,2003) 

2003  .  F0RMAT(1X, 'INST.  DEPTHS  NOT  SAME  FOR  ALL  EVENTS') 

END  IF 

C  CHECK  FOR  NEGATIVE  LATS  AND  LONS;  REVERSE  THEM 
C 

IF (ELATMX.LT. 0.0. AND. ELATMN.LT. 0.0) 

.  TEMP-ELATMX 
.  ELATMX-ELATMN 
.  ELATMN-TEMP 
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END  IF 

IF (ELONMX.LT. 0.0. AND. ELONMN.LT. 0.0) 

.  TEMP-ELONMX 
.  ELONMX-ELONMN 
.  ELONMN-TEMP 
END  IF 

C  ENCODE  min, max  KEYWORD  values  into  EIG  tape  header  buffer 
C 

ENCODE(96 ,6000  ,THBUF(  29  )  )  INUMMN ,  ENTJMMX,  ENUMMN ,DSTMAX , 

+DSTMIN ,  EXPLMX ,  EXFLMN ,  DEPIMN ,  DEPEMX ,  DEPEMN , 

+IDEPMN ,  EDEPMX ,  EDEPMN ,  ICBNMX ,  ICHNHN ,  TYPE  MX,  TYPEMN 

6000  FORMATC3I6, 2113, 212, 616, 213, 212, 2X) 

ENC0DE( 102, 6001, THBUF(61))  SIZEMX, SIZEMN, RANG MX, RANG MN, 

+ILATMN,  ILONMN,  ELATMX,  ELATMN,  ELONMX,  ELONMN 

6001  FORMAT( 10F10.4 , 2X) 

CALL  DPOS(CATLFN,  ELAST) 

CALL  BU?OCT(CATLFN,THBUF,224, IE OF ) 

BUFFER  OCT (11 ,THBUF, B, 224,MSTAT, MLEN) 

ENDFILE  11 
ENDFILE  CATLFN 
CLOSE  CATLFN 

Q  **  HA*imU*til***Ui>Uiii*»i**iii*iiii'm*U»******i»***ntAA* 

C  PRINTED  REPORT 

Q  jrtrk-k*  t*A**»»***iA»»iii  irk**  ****************************  ***  ***** 

IPG-1 

WRITE (REP, 1 )  IPG 

1  FORMATC/// /T53 , 'ROSE  ARCHIVE  REPORT' ,T114, 'PAGE  HO.  ',13) 

WRITE (REP, 2) 

2  FORMAT(//T45 , '*  *  *  SUMMARY  OF  DATA  ARCHIVED  *  *  *'  , 

•T112, 'RUN  DATE, TIME') 

IF(KRA.NE.l) 

.  WRITE (REP , 3 )  IDATE , IT IME 

3  .  FORMAT (T1 11, 3A3,',  ',3A3) 

ELSE 

.  WRITE(REP,4)  IDATE,  HIME 

4  .  FORMAT  (T5  2,  'REPLACEMENT  ARCHIVE»' .Till  ,3A3  , ',  ',3A3) 

END  IF 

C  ENCODE  COMPONENT  TYPES  INTO  COMBIJF 
ALPHA*' 

FOR  K-l  24 

.  ENCODE (3 ,6777 , COMBUF(K) )  ALPHA 

END  FOR 

FOR  K-l.ICHN 

.  FOR  J-1,8 

.  .  IF(IC(K).EQ.J) 

.  .  .  ENCODE (3 ,6777 ,COMBUF(K) )  C(J) 

6777  .  .  .  FORMAT (A3 ) 

.  .  END  IF 

.  END  FOR 
END  FOR 

C  TRANSLATE  START  TIMES  FOR  PRINTING 
CSEC-DSTMIN 
CALL  CNTITM 
FOR  1-1,5 

.  TRAYKl)-TRAY(I) 

END  FOR 
CSEC-DSTMAX 
CALL  CNTITM 

WRITE (REP, 400)  IT AP , IDSH , RDATE , EXCODE 

400  FORMAT(//T5,'RARC  TAPE  #  ', 15 , 13 ,T25, 'DATE  RECEIVED:  ', 
+3A3.T82, 'EXPERIMENT:  ',3A6,A2) 

WRITE ( REP , 40 1 )  IS YR , ISMD , ISDA , ISHR, ISMIN 

401  FORMAT(T5 , 'TAPE  DATA  START  TIME:  ',514) 

WRITE (REP, 40 2)  IFYR, IFMO, IFDA, IFHR, IFMIN 

402  FORMAT (T5,' TAPE  DATA  END  TIME  :  ',514) 

WRITE (REP, 403)  IID.DNAME 

403  FORMAT (/T5,' INSTRUMENT  #:  ',I4,T48, 

.'DESIGNER:  ',9A6) 

WRITE (REP, 404)  IDOC, PLACE 

404  FORMAT (T5, 'DOCUMENTATION  CODE  (YES-1):  ',A3,T48, 

.'INSTITUTION  RECEIVED  FROM:  ',5A6) 

WRITE  (REP,  40  5)  (COMBUF(I)  ,  1-1 ,10)  ,  HAT,  HON 

405  F0RMAT(T5, 'COMPONENTS  1-10  ONLY:  ',10A2 ,T4 8, 'INSTRUMENT  LATITUDE 
+F8. 4, T80,' INSTRUMENT  LONGITUDE:  '.F10.4) 

WRITE (REP, 406)  IDEP.WDEPI 

406  FORMAT(T5, 'INSTRUMENT  DEPTH:  ',16,'  H.',T48, 

.'WATER  DEPTH  AT  INSTRUMENT:  ',14,'  MSEC.') 

WRITE  (REP,  407)  NFHES 

407  FORMAT (T5, 'NUMBER  OF  EVENTS:  ',14) 

WRITE  (REP,  40  8) 
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408  FORMAT (/ /T5 , 'EVENT  KEYWORD  MINIMUM  &  MAXIMUM  VALUES;') 

IF(NSLN.EQ.l) 

.  WRITE (REP, 3 04)  TYPE  MX,  SETLN( 1 ) 

304  .  FORMAT(/T20, 'EVENT  TYPE  ' , 12 ,T48, 'SHOT  LINE  #:  ',A6)  Ql 

END  IF 

IF(NSLN.GT.l) 

.  WRITE (REP, 325)  TYPE MX, SHTLN 
325  .  FORMAT(/T20, 'EVENT  TYPE  '  ,  12  ,T48, 'SHOT  LINE  *S:  ', 

+  .  A6  ,9  (  '  ' ,  A6 ) ) 

END  IF 

WRITE  (REP,  305)  ENUMMN ,  ENUMMX 

305  FORMAT (T20, 'EVENT  #S  ' ,T52 , 16 ,T60 , '  TO  ',16) 

WRIT E ( REP , 3 06 )  (TRAYl (I ) , 1-1 , 5) , (TRAY(I ) , 1-1 , 5) 

306  FORMAT (T20, 'DATA  START  TIMES  ',  514, T60,'  TO  ',16,414) 

WRITE (REP, 308)  ELATMN , ELATMX 

308  FORMAT (T20, 'EVENT  LATITUDES  ' ,T48,F10.3,T60, '  TO  ',F10.3) 

WRITE ( REP , 3  09 )  ELONMN , ELONMX 

309  FORMAT (T20, 'EVERT  LONGITUDES  '  ,T48,F10.3  ,T60, '  TO  ',F10.3) 

WRITE(REP,310)  EDEPMN , EDEPMX 

310  FORMAT(T20, 'EVENT  DEPTHS  ' ,T53 , 15 ,T60 , '  TO  ',15,'  H') 

WRITE (REP, 311)  DEPEMN , DEPEMX 

311  FORMAT (T20, 'WATER  DEPTHS  ' ,T52 , 16 ,T60 , '  TO  ',16,'  M') 

WRITE  (REP,  312)  SIZEMN ,  SIZEMX 

312  FORMAT (T20, 'EVENT  SIZES  ' ,T53 ,F5.1 ,T60, '  TO  ',F5.1,'  KG') 

IF ( EXPL MN. EQ. EXPLMX)  GO  TO  10 

WRITE(REP, 313)  EXPLMN , EXPLMX 

313  F0RMAT(T20, 'EXPLOSIVE  TYPES  ' ,T56 , 12 ,T60, '  TO  ',12) 

GO  TO  15 

10  WRITE(REP, 316)  EXPLMN 

316  FORMAT(T20, 'EXPLOSIVE  TYPE  ',T48,I2) 

15  WRITE (REP, 314)  RANGMN, RANGMX 

314  FORMAT (T2 0 , 'RANGES-EVENT  TO  RCVR  ' ,T52 ,F6 .1 ,T59 , '  TO  ',F6.1,'  KM') 

WRITE(REP, 318)  IQ 

318  FORMAT (T20, 'NUMBER  OF  EARTHQUAKES-  ',16) 

WRITE (REP, 3 17) 

317  FORMAT(lHl) 

CLOSE  OUTF 
CALL  ETIME 
STOP  YEA 

999  STOP  EOF 
END 

SUBROUTINE  AVER 

C  THIS  SUBROUTINE  COMPUTES  THE  MEAN  VALUE  OF  THE  FIRST  200 
C  DATA  POINTS  OF  EACH  CHANNEL  IF  DC  OFFSET  CORRECTION  IS  REQUESTED 
C 

COMMON/ AVG/  IBUF,MEAN 
INTEGER  SUM, IBUF(4096) 

C 

N-0 
SUM-0 
LOOP (20) 

.  FOR  1-1,10 

.  .  SUM-SUM+IBUF(I+N*10) 

.  END  FOR 
.  IF(N.EQ.O) 

.  .  MEAN- SUM/ 10 

.  END  IF 
•  IF(N.GT.O) 

.  .  HEAN-(MEAN+( SUM/10) ) /2 

.  END  IF 

.  N“N+1 

END  LOOP 

RETURN 

END 

SUBROUTINE  RANGER( RLAT, RLON, SLAT, SLON, RAN) 

DR-3.141592654/180. 

DY- RLAT- SLAT 

DX-(  RLON-  SLON  ) *COS  ((  RLAT+  SLAT  )*DR/ 2 . ) 

RAN-1 . 85  2*SQRT (DX*DX+DY*DY )*60 . 

RETURN 

END 
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1:  SMS 

2:  $PR  MACRO  M<BIARC  -  MACRO  TO  ARCHIVE  ROSE  I1ATA  TO  BINARY  CATFILE 
3:  IF , ( . NOT . ( C . SPA • AS 0 ) )  $JU  1GEN 
4:  $FR  ENTER  NAME  OF  HEADER  FILE 
5:  $SR.IT  #FIL 
6:  $AS  11-#FIL 

7:  $PR  INTER  NAME  OF  DATA  FILE 
8:  SSR.IT  #FIL 
9:  $AS  20-#FIL 
10:  PR  TAPE  DRIVE  12 
11:  /PS  12 

12:  PR  TAPE  DRIVE  10 
13:  /PS  10 
14:  PR  TAPE  DRIVE  9 
15:  /PS  9 

16:  PR  TAPE  DRIVE  9 
17:  /PS  9 

18:  PR  ENTER  DRIVE  NO.  TO  RESOURCE 
19:  SSR.IN  #NUM 
20:  $JU  ICOPY 

21:  1GEN  $PR  ENTER  NAME  FOR  DATA  OUTPUT  FILE 

23:  SSR.IT  #FIL 

24:  $GE  #FH  G200  M100000  PI 

25:  JE  318  !BIG 

26:  AS  20-*FIL 

27:  PR  ENTER  NAME  OF  HEADER  FILE 
28:  SR.  IT  #HED 

29:  $  PR  ENTER  NAME  FOR  REPORT  FILE 

30:  $  SR.  IT  #REP 

31:  $  GE  #REP  G-10 

32:  AS  10-REPORT 

33:  AS  11-THEAD 

34:  AS  6-T2 

35:  AS  40-#HED 

36:  AS  30-REVCAT.B 

37:  PR  TAPE  DRIVE  12 

38:  /PS  12 

39:  PR  TAPE  DRIVE  10 
40:  /PS  10 
41:  PR  TAPE  DRIVE  9 
42:  /PS  9 

43:  PR  ENTER  DRIVE  NO.  TO  RESOURCE 
44:  SSR.IN  #NUM 

45:  PR  ENTER  DENSITY  800  OR  1600 
46:  SR.  IN  #DEN 

47:  $PR  LOAD  TAPE  TO  BE  ARCHIVED  ON  DRIVE-CHECK  SCREEN  FOR  ROSTAP 

48:  IF  (#DEN-800)  JU  1EIGHT 

49:  RS  4-ROSTAP  1600B  2C  WA  :#NUM 

50.  JU  I  EXCUT 

51:  I  EIGHT  RS  4-ROSTAP  800B  2C  WA  :#NUM 
52:  ! EXCUT  $151 2ROSE*XBIWH 
53:  JE.P  37  IMAG 
54:  FR  4 

55:  $PR  DISMOUNT  TAPE 

56:  WI  10 

57:  CO  T2  10 

58:  FR  10  40 

59:  RW  11 

60:  CO  REPORT  :6 

61:  CO  REPORT  :6 

62:  ICOPY  $PR  WRITING  TO  BLANK  TAPE?  ENTER  YES  OR  NO: 

63:  SSR.IT  #BLK 

64:  $PR  MOUNT  ARCHIVE  TAPE  WITH  WRITE  RING-CHECK  SCREEN  FOR  ARCTAP 
65:  IF,  (#NUM-11)  SR.N  #NU1« 

66:  RS  4 -ARCTAP  1600B  WR  WA  :#NUM 
67:  IF, (#BLK-"YES" )  $JU  IWRIT 
68:  $$XADV 

69:  IWRIT  SCO  11  4  BB  TB-224  REC  1 

70:  $PR  TAPE  HEADER  FILE  JUST  GENERATED  NW  WRITTEN  TO  ARCTAP 
71:  WE  4 

7  2:  CO  #FIL  4  BB  TB-4144  ALL 

73:  $PR  DATA  WRITTEN  TO  ARCTAP 

74:  PR  NOW  DO  CHECK  READ  OF  ARCHIVE  TAPE 

7  5:  PR  REWIND  TAPE?  (ENTER  RW)  OR  BACK  UP?  (BU): 

76:  SSR.IT  #ANS 

77:  $IF  (#ANS-"RW")  $JU  IREW 

7  8:  $PR  ENTER  NUM  OF  FILES  TO  BACK  (NUM  OF  EVENTS  +  2): 

79:  SSR.IN  #IRC 
80:  $BF  4  #IRC 


81 :  $AR  4 
82:  $JU  IASSN 
83:  1REW  $RW  4 
84:  IASSN  $AS  10-T2 
85:  XDISTAP 

86:  PR  LIST  T2  FOR  CONTENTS  OF  TAPE  HEADER 
87:  FR  4 

88:  $PR  ARCHIVE  PAD  -  DISMOUNT  TAPE,  LOG  &  STORE 
89:  PR  ELIMINATE  DATAOUT  AREA 
90:  $ME 

91:  I  BIG  PR  THAT'S  TOO  MANY  CHARACTERS!  TRY  AGAIN. 

92:  JD  IGEN 

93:  IMAG  PR  FATAL  MAG  TAPE  ERROR:  CHECK  REPORT  FILE  FOR  LINE  #  IN  PROGRAM 
94:  $KE 
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NAME  HEDGEN 

C  *******  Program  H  E  D  G  E  R  to  generate  data  needed  to  build 
C  the  HIG  ROSE  archive  header 

C  The  output  of  this  program  is  an  input  file  to  XBHLR0S 

INTEGER *6  TDST, TDET, CSEC 

INTEGER  RDATE( 3) ,SB£G( 10) , SEND (10) ,TRAY(7 ) 

DIMENSION  PLACE ( 5)  f  SHTLNC  10) 

COMMON/ ITCH/TRAY , CSEC , JULD 
C  INPUT  FROM  THE  TERMINAL 
C 


7950 

8000 

7955 

7967 

7956 
7960 
7965 

8002 

7001 

8003 

8004 

7002 
8011 

7009 

7010 


8007 

1119 

1120 


8050 


VRITE(3,7950) 

FORMATC IX, 'Program  HEDGEN,  Last  modified  4/27/82', 

*/'  to  generate  the  HIG  ROSE  header  parameters  &  other  info.') 
WR1TEC3 ,8000) 

FORMAT ( IX, 'ENTER  ARCHIVE  TAPE  #  &  DASH  NUMBER  :') 

RRAD( 0 , )  ITAP, IDSH 
IDSHl-IDSH 
VRITEC3 ,7955) 

FORMATC IX, 'Enter  instrument  ID  and  number  of  sbotlines:  ) 
READ( 0 , )  I ID , NSLN 
VR1TEC3  ,7967 ) 

FORMATC'  Please  enter  shotlines  in  the  order  in  which  they', 
+/'  appear  on  the  incoming  tape  or  file'/) 


FOR  J-l ,NSLN 
.  WRITE(3 ,7956) 

.  FORMATC IX, 'ENTER  SHOTLINE  #  (UP  TO  6  CHAR;  SLN1S):  ') 

.  READ( 0,7960)  SHTLNC J) 

.  F0RMATCA6) 

.  VRITEC 3 ,7965)  SHTLNCJ) 

.  FORMATC IX, 'ENTER  BEG  AND  END  SHOTS  FOR  SHOTLINE  ',A6) 

.  READC0,)  SB£G(J),SEND(J) 

END  FOR 
VRITEC3 ,8002) 

FORMATC IX, 'Enter  name  of  Institution  tape  received  from:') 
READ (0,7 001)  PLACE 
FORMATC 5 A6) 

WR1TEC3 ,8003 ) 

FORMATC IX, 'ENTER  DOCUMENTATION  CODE;  0-NO, 1 -YES : ') 

READC0 , ) IDOC 
VRITEC3 ,8004) 

FORMATC IX, 'Enter  date  tape  received  as  follows  - 
+'  DAY, MONTH, YE ARC  LIKE  5  OCT  79:') 

READ (0,7 002)  RDATE 
FORMATC 3A3) 

WRITEC3 , 8011 ) 

F0RMATC1X, 'IS  THIS  A  RE-ARCHIVE?  YES-1:  ') 

READC0,)  KRA 
IF(KRA.EQ.l) 

.  WRITEC3 ,7  009 ) 

.  FORMATC'  Enter  old  dash  number  as  in  Catalog:') 

,  READC0,)  IDSHl 
END  IF 

WRITEC3 ,7  010) 

FORMATC'  If  there  is  no  DC  offset  to  remove  and  no  tape  heade 
+/ '  parameters  to  override,  enter  0:') 


READC3 , )  IKK 
IF(IKK.GT.O) 

VRITEC 3, 8007) 

FORMATC IX, 'TAKE  OCT  DC  OFFSET?  YES-1:') 

READCO.)  KDC 
VRITEC3 ,1119 ) 

FORMATC IX, 'OVERRIDE  #  OF  FILES?  IF  NO,  ENTER  0;  ', 

/'  IF  SO,  ENTER  #  OF  FILES  TO  PROCESS:') 

READCO,)  IOVRD 
VRITEC3 ,1120) 

FORMATC'  WANT  TO  ENTER  NEW  START  4  END  TIMES?  YES-1:') 
READCO,)  JNE 
TDST-0 
TDET-0 
IF(JNE.EQ.l) 

.  VRITEC3 ,8050) 

.  F0RMATC1X,"  Enter  start  time;as  IYR>I^C,IDA,IHR,IMN:,,) 
.  READCO,)  (TRAY(I), 1-1,5) 

.  TRAY  C  6 ) -0 
.  TRAY(7)-0 

.  CALL  ITMCNT 
.  TDST- CSEC 
.  WRITEC3 ,8060) 
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83: 

84: 

85: 

86: 

87: 

88: 
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98: 

99: 

100 
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103 

104 
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106 

107 

108 
109 

no 

in 

112 

113 


READ(0,)  (TRAY(I), 1-1,5) 

CALL  ITMCNT 
TDET-CSEC 
END  IF 
END  IF 

C  WRITE  ALL  PARAMETERS  TO  HEADER  FILE 

VRITE(40 ,9  000)  ITAP,  IDSH,  IID,NSLN 

9000  FORMAT ( '  Tape  number'  ,T50 , 13  ,  /  '  Dash  number'  ,T50 , 13  , 

♦/ '  Instrument  ID' ,T50, 15 ,/ '  Number  of  shotl ines' ,T50, 13) 
FOR  J-1,NSLN 

WRITE(40,9001)  J,SHTLN(J),SBEG(J),SEND(J) 

9001  F0RMATC'  Shotline' ,13,'  *nd  shots' ,T50,A6 ,215) 

END  FOR 

WRITE (40 ,9 002)  PLACE, IDO C, RDATE 

9002  F0RMAT('  Designer  name  and  address' ,T50,5A6 , 

+/'  Documentation  code' ,T50, 13 , / '  Date  received' ,T50,3A3) 
WRITE(40 ,9 003)  ERA, IDS Hi 

9003  FOEMAT('  Rearchiving?  Yes-1 ' ,T50, 13 , /'  Old  dash  number-' 

♦  'if  rearchiving',T50, 13) 

WRITE  (40 ,9004)  IKK 

9004  F0RMAT('  Deviations  from  standard  archive?  No-0' ,T50 , 13 ) 

IF  (IKK.  NE.  0) 

WRITE(40 ,9 005)  KDC.IOVRD 

9005  FORMATC'  Take  out  DC  offset?  Yes-1 ' ,T50, 13 , 

+/'  Override  number  of  files  as  in  tape  header?', 

+/'  No-0,  Yes-new  #  of  f iles' ,T50, 14) 

WRITE (40, 9 006)  JNE, TDST, TDET 

9006  FORMAT ( '  Override  tape  start  and  end  times?  Yes-1 ', T50, 13 , 
+/'  New  start  time  (century  msec ) ',T50, 114, 

+/'  New  end  time  (  ”  "  )',T50,U4) 

END  IF 

STOP 

END 
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C  PROGRAM  TAPOS  TO  POSITION  H1G  ARCHIVE  TAPES 
C 

C  LAST  MODIFIED  6/17/82  SLL 

C 


NAME  TAPOS 

INTEGER  TAPE, JBUF(4096) 
DATA  TAPE/ 4/ 


C 

C 


1 


1000 


1002 


1009 


1011 


1008 

2 


1010 


ICNT-0 

LOOP 

.  BUFFER  IN  (TAPE, JBUF , B,4096 ,  IS ,  IL) 

.  CALL  STATCS(TAPE) 

.  ICNT-ICNT+1 
.  IF  (IS.GE.4)  STOP  EOT 
.  IF(IL.EQ.O)  GOTO  1 
•  IFCIL.EQ.4096) 

.  .  IF(ICNT.EQ.l) 

.  .  .  WRITE(3»1000) 

.  .  .  FORMATC"  Data  word; advancing  to  next  header") 

.  .  END  IF 

.  .  GO  TO  1 

.  END  IF 
.  UCXL.EQ.256) 

.  .  WRITEC3 ,1002)  JBUF ( 1 ) , JBUF ( 3 ) 

.  .  FORMATC "  Instrument",  15/  Event", 16) 

.  .  EXIT  LOOP 

.  END  IF 
.  IFCIL.EQ.224) 

.  .  CALL  DECHDRC JBUF, NF , 1 ) 

.  .  EXIT  LOOP 

.  END  IF 

.  IF C XL. NE. 224. AND.  IL.NE.256  .AND.  IL.NE.4096  .AND.  IL.  NE. 0) 

.  .  VRITEC3 , 1 009 )  IL 

.  .  FORMATC'  WORD  LENGTH  ',15/  NOT  STANDARD  ROSE  FORMAT") 

.  .  STOP  ERR 

.  END  IF 
END  LOOP 
VRlTE(3 , 1011) 

FORMATC"  Position  to  the  end  of  the  Nth  archive;  enter  N:", 
+/ '  or i  rewind  and  start  over;  enter  0  ) 

READC 0 , )  NPOS 
IF(NPOS.EQ.O) 

.  REWIND  TAPE 
.  GO  TO  1 
END  IF 
LCNT~0 
N-NP0S-1 

IFCNF.EQ.0)  NF-999 
LOOP 

.  IF(N.EQ.O)  GO  TO  2 
.  DO 

.  .  BUFFER  IN  (TAPE, JBUF, B, 4096, IS, IL) 

.  .  CALL  STATU SC TAPE) 

.  UNTIL ( IL. EQ. 224) 

.  LCNT*LCNT+1 

.  CALL  DECHDRC JBUF, NF, LCNT) 

.  WRITEC3 , 1 008) 

.  FORMATC"  Continuing  to  advance") 

.  LOOP  CNF) 

.  .  DO 

.  .  .  BUFFER  IN  (TAPE,  JBUF,  B,  4096,  IS,  IL) 

.  .  .  CALL  STATU SC TAPE) 

.  .  .  IFCIL.EQ.224) 

.  .  .  .  BACKSPACE  TAPE 

.  .  .  .  EXIT  LOOP 

...  END  IF 
.  .  UNTIL(IL.EQ.O) 

.  END  LOOP 

.  EXIT  LOOP  IF(LCNT.GE.N) 

END  LOOP 
WRITE(3 ,1010) 

FORMATC '  Tape  positioned') 

STOP 

END 


SUBROUTINE  DECHDRCTHBUF.NFILES.IDASH) 

INTEGER  THBUF(l) , ENUMMN , ENUMMX 

DECODE (18, 6 001 ,THBUF(29 ) )  INUM, ENUMMX, ENUMMN 

FORMAT (3 16) 


6001 


81:  DECODE ( 84  ,6002  ,THBUF(95)  )  UTILES 

82:  6002  FORMAT/ 8X,  16) 

83:  DECODE  (6 ,6003  ,THBUF(2)  )  ITAP 

84:  6003  FORMAT(I6) 

85:  WRITE  (3, 1004)  ITAP,  IDASH,  INTJH,  ENUMMN ,  ENUHMX,  NFILES 

86.  1004  FORMATC '  TAPE', 14/  -  ',13/  :  INSTRUMENT  ',14, 

87:  +  '  EVENTS ',16 ,'-',16/  *  FILES:', 16) 

88:  RETURN 

89:  END 
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A  PROGRAM  TO  CONVERT  HIG  DEMULTIPLEXED  DATA  AND  CORPILE  INFORMATION  TO 
ROSE  ARCHIVE  FORMAT  AND  WRITE  BINARY  CATALOG  RECORDS. 

WRITTEN  BY  SLL  10/10/79  WITH  MUCH  HELP  FROM  MIKE  SIMPSON 
LAST  MODIFIED  5/4/82  SLL 

ASSIGNMENTS:  AS  10- REPORT  FILE 

AS  11-TEMP  HEADER  STORAGE  FILE  (THEAD) 

AS  12-HDLFN( SEE  HEDGEN) 

AS  15-ROSE  TAPE  HEADER  FILE(RHEAD) 

AS  20-TEMPORARY  ROSE  ARCHIVE  FILE  HEADER  RECO 
AS  30-CATALOG  FILE  (REV CAT) 

AS  40 -CORPILE  FOR  THE  DATA  SET 
AS  50-ROSE  FORMAT  DATA  OUT  FILE 
AS  61-64-DEMUX  DATA  FILES 

DIMENSION  MBUF(260) , JCOR(140) , JBUF(18) ,HHDR(257 ) ,SHTLN(10) 

DIMENSION  C(8) ,COMBUF(24) 

INTEGER  RCV ,  TYPE  ,  SNUM,  RMM,  REM ,  RUM ,  RERR ,  RLATD ,  RL ATM 
INTEGER  RLOND, RLONM, SLATD, SLATM, SLOND, SLONM, SDEP 
INTEGER  EXPL, SIZ,BtJB,  SAMP,FNUM,WDEFE,WDEPI,EDEP 
INTEGER  CATLFN , DEP IMX , DEPIMN , DEPEMX , DEPEMN , RDATE ( 3 ) , IDAT2(3) 

INTEGER  ENUMMX ,  ENUMMN ,  EXPLMX,  EXPLMN,  ICHNMXfHDLFN 

INTEGER  ICHNMN , TYPE MX, TYPEMN , EDEPMX, EDEPMN , REP , ELOER 

INTEGER  IC ( 24 ) , CCODE , ENUM, IDATE ( 3 ) , ITIME (3) , THBUF( 224) , CATBUF (112) 

INTEGER  CPAR (20,4), SHTLTH , TRAY 1(7 ) ,  TRAY  (7 ) , ISW( 2) , SBRK(6) 

INTEGER  DBUF ( 54 ) , IBUF ( 40  3  2 ) , KBUF (409  6 ) , OUTLFN , CORLFN , THLFN 
DIMENSION  PLACE (5) , DNAME (9 ) , EXCODE (4) 

INTEGER  F(3,12),F1(3),F2(3),F3(3),F4(3),F5(3),F6(3),F7(3) 

INTEGER  F8(3) ,F9(2),F10(2)  ,F11( 2)  ,F12( 2) ,  SBEG(  10)  ,SEND(10) 

REAL  HAT,  HON ,  ILATMX,  HATMN ,  ILONMX,  ILONMN 
INTEGER* 1  ICRAY (162) , DCBUF (162) 

INTEGER*6  CSEC, SBT,DST, ISTAT,DSTMAX,DSTMIN, TDST, TDET, ISTATS( 2) 
EQUIVALENCE  (ISTAT,  ISW)  ,  (ISV(  2)  ,  ILEN ) 

EQUIVALENCE  (KBUF ( 1 ),  ICRAY ( 1 )  )  ,  (DBUF, DCBUF ) 

EQUIVALENCE  (Fl ,F) , (F2 ,F( 1 ,2 ) ) , (F3 ,F( 1 ,3) ) , (F4,F( 1 ,4) ) 

EQUIVALENCE  (F5 ,F( 1 , 5 ) ) , (F6 ,F(1 ,6 ) ) , (F7 ,F( 1 ,7 ) ) , (F8 ,F( 1 , 8) ) 
EQUIVALENCE  (F9,F(1,9)),(F10,F(1,10)),(F11,F(1,11)),(F12,F(1,12)) 

C 

EQUIVALENCE  (CATBUF ( 1 ) , JTYPE ) , (CATBUF(2) , ITAP) , (CATBUF(3) ,INUM) 
EQUIVALENCE  (CATBUF(4) ,ENUM) , (CATBUF (7 ) , SBT) , (CATBUF (22) ,WDEPI) 
EQUIVALENCE  (CATBUF (5) ,DST) , (CATBUF (9 ), SIZE) , (CATBUF ( 11 ), RANGE) 
EQUIVALENCE  (CATBUF  ( 13  )  ,  ILAT ) ,  ( CATBUF ( 15 ) ,  ILON ) ,  (  CATBUF  ( 17  )  ,  ELAT ) 
EQUIVALENCE  (CATBUF ( 19  )  ,EL0N) ,  (CATBUF (21 )  ,EXPL) 

EQU IVALEN CE  ( CATBUF ( 23  )  ,  WDEPE ) ,  ( CATBUF  ( 24 ) ,  IDEP ) ,  ( CATBUF  ( 25 ) ,  EDEP ) 
EQUIVALENCE  (  CATBUF  (  28)  , RERR) ,  (CATBUF (29  ), ELOER)  ,  (CATBUF (30)  ,  BUB ) 
EQUIVALENCE  (CATBUF (31 )  ,  SAMP)  ,  (CATBUF (32)  ,WDS) 

EQUIVALENCE  (CATBUF (33) ,7NUM) , (CATBUF (34) ,NREC ) , (CATBUF (35) ,NSAM) 
EQUIVALENCE  (CATBUF ( 36) , IDEL) , (CATBUF (37 ), IDATE) 

EQUIVALENCE  (CATBUF ( 27  )  , TYPE  ),  (CATBUF (67  )  ,  SHTLIN) 

EQUIVALENCE  (CATBUF ( 26 ) ,  ICHN)  ,  (CATBUF (43 ),  IC ) 

EQUIVALENCE  (CATBUF(40)  ,IDAT2)  , (CATBUF (69)  , CCODE) 

COMMON/ IT CM /TRAY , CSEC, JULD 

DATA  THLFN/ 15/ , CATLFN/ 30/  , CORLFN/40/  , OUTLFN/ 50/ , REP/10/ 

DATA  HDLFN/12/,C(1)/'W,C(2)/<R'/, 

+C(3)/"r/,C(4)/"P"/,C(5)/'Hl'/,C(6)/'H2'/,C(7)/'W'/,C(8)/  TI  / 

DATA  Pl/'(lX,l8)'/>F2/"(lX,I7)'/,73/'(U,l6)V,F4/'(lX,l5)V 
DATA  F5/'(1X,I4)'/,F6/'(1X,I3)'/,F7/"(1X,I2)"/,F8/'(1X,I1)'/ 

DATA  F9r(l4)'/,F10/'(l3)'/,Flir(l2)7,7l2/'<H)'/ 

C 

CALL  BTIME 
CALL  DATE (IDATE) 

CALL  TIME(ITIME) 

FOR  1-1,3 

.  IDAT2  ( I ) -IDATE  ( I ) 

END  FOR 

C  ZERO  IC  ARRAY  AND  SHTLN  ARRAY 
FOR  1-1,24 
.  IC(I)-0 

END  FOR 
FOR  1-1,10 
.  SHTLN( I )-M 
END  FOR 
C 

WRITE(3 ,7950) 

7950  FORMAT( IX, 'Program  BHIROS,  REV.  4,  Last  wodified  4/29/B2  ) 

READ (HDLFN, 8000)  ITAP, IDSB, IIDl ,NSLN 
8000  FORMAT (T50, 13 , /T50,I3,/T50,I5,/T50,I3) 
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FOE  J-1,NSLN 

.  READ (HDLFN,  8001)  SHTLN(  J)  , SBEG(  J)  , SEND( J) 

8001  .  FORMAT ( T5 0 ,A6 ,215) 

END  FOR 
IEVST-SBEG(l) 

READ (HDLFN, 8002)  PLACE, IDO C, RDATE 

8002  FORMAT (T50 , 5A6 , /T50 , 13 , /T50 ,3A3  ) 

READ (HDLFN, 8003)  ERA, IDS Hi ,  IKK 

8003  FORMAT (T50 , 13 , 2( /T50 , 13 ) ) 

IF(IKK.NE.O) 

.  READ (HDLFN, 8004)  KDC, IOVRD, JTC 

8004  .  FORMAT(T50,I3,/T50,I4,/T50,I3) 

.  IF(JTC.EQ.l) 

•  .  READ (EDLFN, 8022)  TDST,TDET 

8022  .  .  F0RMATC2I14) 

.  END  IF 
END  IF 

C  ENCODE  HIG  HEADER  INFO  INTO  TAPE  HEAD  BUFFER 

C 

JTYPE-2 

ENCODE (84 ,7  500 ,THBUF )  JTYPE ,  ITAP,  NSLN,  (PLACE(I)  ,1*1,5),  IDOC, 
+(RDATE(I),I-1,3),(IDATE(I),I-1 ,3)  ,  (IDATE(I)  ,  1-1 ,3)  , 

+( IDATE  ( I ) ,  1*1 , 3  ) 

7500  FORMAT (13 ,2I6,5A6,13A3) 

ENCODE (3, 7 501 , THE UP (160) )  IDSH 

7501  FORMAT( 13 ) 

C  READ, WRITE  TAPE  HEADER  BUILT  WITH  PROGRAM  ROSEHD 
OPEN  THLFN 
OPEN  OUTLFN 
LOOP 

.  BUFFER  IN  (THLFN, MBUF, B,  256  ,MSTAT,MLEN) 

•  CALL  STATUS (THLFN) 

.  EXIT  LOOP  IF  (MSTAT.GE.3) 

.  L-0 

.  FOR  1-1,4 

.  .  FOR  J-1,20 

.  .  .  CPAR(J,I)-KBUF(54+J+L) 

.  .  END  FOR 

•  .  L-L+20 

•  END  FOR 

.  FOR  1-55,260 
.  .  MBUF(l)-0 

•  END  FOR 

.  FOR  1-1,4 

•  •  IC(I )-CPAR( 1 , I ) 

•  END  FOR 

.  BUFFER  OUT (OUTLFN, MBUF, B, 256 ,MSTAT,MLEN) 

•  CALL  STATUS (OUTLFN) 

•  ENDFILE  OUTLFN 
.  WRITE(3 , 200) 

200  .  FORMAT ('  TAPE  HEADER  WRITTEN') 

C  DECODE  TAPE  HEADER  FOR  REEDED  INFO 
.  J-l 

.  FOR  1-1,162 
.  .  K-MOD(I,3) 

.  .  IF(K.NE.l) 

.  .  .  DCBUF(J)-ICRAY(I) 

•  •  •  J— J+ 1 

.  .  END  IF 

.  END  FOR 
C 

C  DECODE  I  ID 


J-l 

1-0 

FOR  K-4,1,-1 
.  IF(DCBUF(K) .NE. '  ') 
.  .  I-I+l 

.  .  IF(I.EQ.l) 

.  .  .  IP-J+8 

•  •  END  IF 

.  END  IF 
.  J-J+l 


IND  FOR 

DECODE (4,F(1 , IP) ,DBUF )  IID 
C  DECODE  NUMBER  OF  FILES 
J-l 
1-0 


FOR  K-108, 101,-1 
.  IF(DCBUF(K).NE. '  ') 
.  .  I-I+l 
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214 
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.  IF(I.BQ.l) 
.  .  IP-J 

.  END  IF 
END  IF 
J-J+l 


END  FOR 

DECODE  (9  ,F(1 ,  IP)  ,DBUF(34)  )  NFILES 
C  DECODE  THE  REST 

DECODE ( 55 , 8005 ,DBUF(2) )  DRAKE 

8005  .  FORMAT ( IX ,  9  A6  ) 

DECODE  ( 20 , 8006  ,DBUF ( 21 )  )  EXCODE 

8006  .  FORMAT ( 3 A6,A2) 

DECODE  (12,8010,  DBUF  ( 27  )  )  ISYR ,  IS>© ,  ISDA,  ISHR,  IS  MIN 
8010  •  FORMAT ( 2X, 512 ) 

DECODE(10,8020,DBUF(31))IFYR,  IFMO,  IFDA,  IFHR,  IFM  IN 

8020  .  FORMAT  (512) 

WRITE(3 , 8040)  I  ID, NFILES 

8040  .  FORMAT (IX, "INSTRUMENT  ID  ",14,/,"  #  FILES  ",I4) 
IF(IOVRD.NE.O) 

.  NFILES- 10  VRD 
.  WRITE(3 , 8041 )  NFILES 
8041  .  .  FORMAT ( '  #  FILES  RESET  TO: ',16) 


1120 

8045 

8046 
8050 
806  0 


C  ENCODE 
C 

7600  . 

C 


END  IF 

VRITE(3,1120)  IEVST 

FORMAT (IX /STARTING  WITH  EVENT  #/fl5) 

WRITE(3 ,8045)  DNAME 

FORMAT (IX /DESIGNER  NAME  &  ADDRESS:  ',9A6) 

WRITE (3, 8046)  EXCODE 

FORMAT ( IX , 3 A6 , A2  /  EXPERIMENT') 

WRITE(3 , 8050) ISYR, ISMD, ISDA, ISHR, ISMIN 
FORMAT (IX /START  TIME  M,5(1X,I2)) 

WRITE  (  3 , 806  0)  IFYR ,  IFMO ,  IFDA ,  IFHR ,  IFM  IN 
FORMAT( IX, "END  TIME  ",5(1X,I2)) 

IF(JTC.EQ.O) 

.  TRAY ( 1 )-ISYR 
.  TRAY  ( 2)-ISMO 
.  TRAY ( 3 ) - IS  DA 
.  TRAY(4) -ISHR 
.  TRAY (5) -ISMIN 
.  TRAY(6)-0 

.  TRAY (7 )-0 
.  CALL  ITMCNT 
.  TDST-CSEC 
.  TRAY(1)-IFYR 
.  TRAY ( 2) -IFMO 
.  TRAY  (  3  )  -  IFDA 

•  TRAY(4)-IFHR 

.  TRAY ( 5)-IFMIN 
.  CALL  ITMCNT 

*  TDET-CSEC 
END  IF 

TAPE  HEADER  INFO  INTO  CURRENT  TAPE  BUFFER 

ENCODE ( 17 4 ,7 600 ,THBUF(95 ) )  I ID, DNAME , EXCODE , NFILES , TDST, TDET, SHTLN 
FORMAT(I4,12A6,A2,I6,I14,1X,I14,1X,10A6) 


END  LOOP 
FOR  1-1,260 
.  MBUF(l)-0 
END  FOR 


C  GET  HEADER  INFO  FROM  DEMUX  FILE  PLUS  POSITION  TO  GET  MORE  LATER 
FOR  1-1,4 
.  LFN-60+I 
.  OPEN  LFN 
END  FOR 
LFN-61 

CALL  DPO  S ( LFN , 2 ) 

CALL  BUFIN(LFN , KBUF, 112,  IE  OF  ) 

C  COMPUTE  #  SAMPLES  IN  LAST  RECORD  FOR  EACH  SHOT  FROM  SHOT  LENGTH 
SBTLTH-MBUF  ( 111 ) 

NSAM-HOD  ( SHTLTH ,  409  6  ) 

IF(NSAM.NE.O) 

.  NREC-SHTL TH/4096+1 
ELSE 

.  NREC- SHTLTH/ 409  6 
END  IF 

D  VRITE(3 ,5005)  SHTLTH , NREC , N SAM 

D5005  FORMAT ( IX / SHOT  LTH:', I6/N0.  RECS / SHT / ,  14 /  REMAINDER:  ',  15) 
FOR  1-1,4 


241 

242 

243 

244 

245 

246 

247 

248 

249 

250 

251 

252 

253 

254 

255 

256 

257 

258 

259 

260 

261 

262 

263 

264 

26  5 

266 

267 

26  8 

269 

27  0 

271 

27  2 

27  3 

27  4 

27  5 

27  6 

277 

27  8 

279 

280 

281 

282 

283 

284 

285 

286 

287 

288 

289 

290 

291 

292 

293 

294 

295 

296 

297 

298 

299 

300 

301 

302 

303 

304 

305 

306 

307 

308 

309 

310 

311 

312 

313 

314 

315 

316 

317 

318 

319 

320 


.  CPAR(11,I)-NREC 
.  CPAR( 12 , I)-NSAM 
END  FOR 

C  POSITION  DEMUX  FILE  #1(LFN  61)  TO  ITS  HEADERS 
CALL  DPOS(LFN,MBUF ( 112) ) 

D  WRITE(3 ,201 ) 

D201  FORMAT (IX, "DEMUX  FILE  POSITIONED") 

C 

IDEL-0 

C  ZERO  WORKING  BUFFER 
FOR  1-1,260 
.  MBUFCD-0 
END  FOR 

C  FIND  POSITION  OF  START  OF  TAPE  HEADERS  IN  CATALOG 
OPEN  CATLFN 
CALL  DPOS( CATLFN, 2) 

CALL  BUFIN ( CATLFN , MBUF ,112, IE OF ) 

ITHEAI^MBUF  (112) 

C  SAVE  OFF  TAPE  HEADER  RECORDS 
C 

OPEN  11 

INEXT-ITHEAD 

CALL  DPOS ( CATLFN, INEXT) 

LOOP 

.  ISAV-0 

.  CALL  BUFIN(CATLFN, MBUF, 224, IE OF) 

.  EXIT  LOOP  IF(XEOF.GE.3) 

C  IF  REAR CHIVING,  DONT  SAVE  TAPE  HEADER  RECORD  FOR  THIS  TAPE 
IF(KRA.EQ.l) 

•  DECODE(9, 7550, MBUF)  KTAP 
.  FORMAT (3X, 16) 

.  DECODE (6 ,7  553 , MBUF (95) )  INM 
.  FORMAT ( 14 , 2X) 

•  DECODE (6, 7 551  , MBUF (121) )  NF 
.  FORMAT( 16) 

•  DECODE (3 ,7  501 , MBUF ( 160) )  IDASH 
.  IF(KTAP.EQ.ITAP) 

.  .  IF(IDSH1. EQ. IDASH. AND. NFILES.BQ.NF. AND. IID.EQ. INM) 

.  .  .  VRITE(3 ,7 552)  ITAP, IDSHl , IID, NFILES, KTAP, IDASH, INM, NF 

•  •  .  FORMAT(lX,"  Input  tape , instrument ,#f iles : ' , 16 , , 12 ,2 16 , 

.  .  .  r  catalog  file  tape, instrument,#! ilea: ',16, 12,216) 

.  .  .  VRITE(3,7  554) 

.  .  .  FORMATC"  We  have  a  match ;Execute  replacement  ARCHIVE", 

.  •  •  '  after  saving  remaining  headers') 

.  .  .  INEXT-MBUF ( 153 ) 

.  .  .  ISAV-1 

.  .  END  IF 

.  END  IF 
END  IF 

IF(ISAV.EQ.O) 

.  BUFFER  ODT(ll, MBUF, B, 224, MSTAT,MLEN) 

.  CALL  STATU S( 11 ) 

END  IF 
END  LOOP 
REWIND  11 
THBUF(  153) -INEXT 
CALL  DPOS (CATLFN, INEXT) 

WRITE(3 ,1 050) 

1050  FORMAT( /IX, "Begin  reading  &  writing  event  header  records") 

C  ***************  ***************'********************'«***»**«*«*****« 

C  LOOP  TO  BUILD  ARCHIVE  FILE  HEADER  RECORDS 
C  (BOTH  FOR  ARCHIVE  FORMAT  AND  CATALOG  FILE) 

C  «««<  FIRST  CORFILE  »»»» 

FNUlW 
JTYPE-1 
OPEN  20 
OPEN  COHLFN 
LOOP 

II  .  BUFFER  IN  (CORLFN,JCOR,B,140,JSTAT,JLEN) 

.  CALL  STATUS(CORLFN) 

.  EXIT  LOOP  IF(JSTAT.GE.3) 

.  DECODE(60,7011 , JCOR)  RCV, SNUM, (SBRK(I) ,  1-1 ,6) ,K 

7011  .  FORMAT (216,21, 14,13,312,13,12,281) 

.  IF(FNUM.EQ.l) 

.  .  IF ( SNUM. NE. IEVST )  GO  TO  11 

.  END  IF 

,  WRITE(3,7011)  RCV, SNUM, (SBRK(I) ,I"1 ,6) ,K 

.  DECODE(60,7012  ,JCOR(  21) )  SCORR,  SD,  SIZE, RCORR.RD, RANGE 

7012  .  FORMAT (6F 10, 4) 


7550 

7553 

7551 

7552 

7554 
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321 : 

• 

DECODE (60 ,7 012, JCOR( 41 ) )  CSRAN , BTC, SBATC , SDC , SDIST, RBATH 

322: 

« 

DECODE (60,7 013  ,JCOR(61))  RDC,RDIST,RV,WV1  ,  EL  AT,  BUB,  EXP  L 

323:  7013 

• 

FORMAT (  5F 1 0 . 4 , 14 , 12 , 4X  ) 

324: 

9 

DECODE (6 0,7 014,  JCOR(  81 )  )  ELON ,  BATH S , BLS ,  HAT 

325:  7014 

• 

FORMAT ( 1  OX , 4F 10 . 4 , 1  OX ) 

326: 

DECODE (6 0,7  015,  JCOR(  101)  )  HOH.TT.TDIST.TPSl  ,TPS2 

327:  7015 

• 

FORMAT (10X,5F10.4) 

328: 

♦ 

DECODE (60, 7016 ,JCOR( 121 ) )  TPS3 ,CTDAT, CTDATR.WWCl ,WWC2 , SRKM 

329:  7016 

FORMAT ( 6F 1 0 . 4 ) 

330:  C  CONVERT  TO  ROSE  FORMAT 

331: 

RMM»IFIX(RANGE*1000. ) /1000000 

332: 

REM- IFIX ( RANGE )-RMK* 1 000 

333: 

RDM- RDP ( RANGE* 1 000 .) -RKM*1 000- RMH* 1 000000 

334: 

RERR-500 

335: 

# 

KLATD-IFIX(ILAT) 

336: 

m 

EL AT>^  ( RDP ( ILAT* 1 000 . ) -RLATD* 1 0 00 ) 

337: 

RLOND-IFIX(ILON) 

338: 

• 

KLONM-  (  RDP  ( ILON*  1 000 .  ) -RLOND*  1 000 ) 

339: 

• 

SLATD- IFIX(ELAT) 

340: 

• 

SLATM- ( RDP ( ELAT*1 000 .  ) -SLATD*  1 000) 

341: 

SLONI^IFIX(ELON) 

342: 

SLONH-(HDP(ELON*1000.)-SLOND*1000) 

343: 

RDM-RD*1000. 

344: 

IDEP-RDP(RDM) 

345: 

. 

UK  RD/1. 5)*1000. 

346: 

WDEPI-RDP(RD) 

347: 

BATHS- (BATHS/ 2.0)*  1.5 

348: 

WDEPE- RDP (BATHS) 

349: 

. 

ELOER-250 

350: 

TTPE-2 

351: 

9 

IF(SBRK(1 ) .LT. 1900) 

352: 

* 

.  SBRK(1)-SBRR(1)+1900 

353: 

END  IF 

354: 

TRAYU)-SBRK(l) 

355: 

JULI>SBRK(2) 

356: 

# 

FOR  1-3,6 

357: 

.  TRAY(I+1)-SBRK(I) 

358: 

« 

END  FOR 

359: 

CALL  ULCNT 

360:  C  CORRECT  SHOT  BREAK  TIME  WITH  BURN  TIME  CORRECTION 

361: 

, 

IBTOO 

362: 

m 

IF(BTC.NE.O.O) 

363: 

.  IBTC-RDP(BTC*1000.) 

364: 

.  CSEC-CSEC-IBTC 

365: 

END  IF 

366: 

. 

CALL  CNTITM 

367: 

FOR  1-1,7 

368: 

. 

.  MHDR(I+27)-TRAY(I) 

369: 

# 

END  FOR 

370: 

SIZ-RDP((ALOG10(SI2E*1000.))*1000.) 

371: 

EDEP-SD*1000. 

372: 

SDEP-RDP ( SD*1000 . ) 

373: 

RERR-500 

374: 

ICHN-4 

37  5: 

. 

NWDS-4096 

376: 

# 

CCODE-0 

377  : 

. 

MHDR(60)-CCODE 

378: 

FOR  1-1,4 

379: 

.  L“10*(6+2*(I-1)) 

380: 

.  FOR  K-1,20 

381: 

.  .  LL-L+K 

382: 

.  .  MHDR(LL)-CPAR(K,I) 

383: 

. 

.  END  FOR 

384: 

. 

END  FOR 

385: 

FOR  1-42,59 

386: 

.  HHDR(l)-0 

387: 

• 

END  FOR 

388: 

• 

FOR  1-141,256 

389: 

.  MHDR(I)-0 

390: 

END  FOR 

391:  C 

««<«<  SECOND  DEMDX  HEADERS  »»»»»> 

392:  12 

CALL  BUFIN  (LFN ,  JBDF ,  1 8 ,  HOF ) 

393: 

9 

EXIT  LOOP  IF(IEOF.GE.3) 

394: 

m 

DECODE ( 54 ,7  000 , JBDF ) INTO, ENDM, ICH, SBT.DST, SAMP, IDA 

395:  7000 

m 

FORMAT( 216 , 12 , 2 116 , 13 ,2X, A3 ) 

396: 

9 

IF(FNDM.EQ.l) 

397: 

• 

.  IF(ENDM.NE.IEVST)  GO  TO  12 

398: 

• 

END  IF 

399: 

• 

SBT-SBT-IBTC 

400: 

# 

JTCK-CSEC-SBT 

401 

402 

403 

404 

405 

406 

407 

408 

409 

410 

411 

412 

413 

414 

415 

416 

417 

418 

419 

420 

421 

422 

423 

424 

425 

426 

427 

428 

429 

43  0 

431 

432 

433 

434 

435 

436 

437 

438 

439 

440 

441 

442 

443 

444 

445 

446 

447 

448 

449 

450 

451 

452 

453 

454 

455 

456 

457 

458 

459 

460 

461 

462 

463 

464 

465 

466 

467 

468 

469 

47  0 

471 

47  2 

47  3 

474 

47  5 

47  6 

477 

47  8 

479 

480 


.  IF(JTCK.NE.O) 

.  .  WRITE(3,5052)  JTCK,ENUM 

5052  .  .  FORMAT ( IX ,  ' SHOT  BREAK  TIME  ON  DEMDX  FILE  DOESNT  MATCH  CORFILE' 
+  .  .  /'  TWO  TIMES  DIFFER  BY  ',16,'  MSEC  FOR  SHOT' ,16) 


.  DfD  IF 
.  MHDR(257  )-IDA 
.  CSEC-DST 

•  CALL  CNTITM 

•  FOR  1-1,7 

.  .  MHDR ( 1+3 ) -TRAY ( I ) 

.  END  FOR 
D  CSEOSBT 

D  CALL  CNTITM 

D  WRITE (3 , 5050) INUM,  ENUM,  TRAY,  (MBDR(  I )  ,  1*4, 10) 

D5050  FORMAT ( '  R-  ',14,'  S-',I5,'  SBT&DST:  ',T30,I4,5I3 , 14,155,14, 

D  .513,14) 

D  WRITE(3 , 5057 )  IDA 

D5057  FORMATC1K, '*** ** ******«DATA  START  ADDR :  ',16) 

C  COMPARE  DEMDX  6  CORFILE  FOR  RCV/SHT  MATCH 
IF  (INUM.NE.RCV) 

.  VRITE(3 ,3040)  INUM,RCV 
3040  .  .  FORMAT ('  RCV#S  DEMDX  VS  CORFILE  DO  NOT  MATCH: ',216) 

.  IERR-1 
.  EXIT  LOOP 
END  IF 

IF  (ENUM.  NE.  SNUM) 

.  VRITE(3 ,3050)  ENUM, SNUM 
3050  .  .  FORMAT ( '  SH0T#S  DEMDX  VS  CORFILE  DO  NOT  MATCH: ',216) 

.  IERR-1 
.  EXIT  LOOP 
END  IF 

FOR  JK-1  ,NSLN 

.  IF (ENUM. GE. SBEG( JR) .AND. ENUM. LE. SEND( JK) ) 

.  .  SHTLIN-SHTLN(JK) 

.  END  IF 
END  FOR 

C  WRITE  VARIABLES,  INCLUDING  KEYWORDS,  TO  CATALOG 


.  CALL  BUFOUT(CATLFN, CATBUF, 112, IE OF ) 

.  CALL  D$TAT(CATLFN , ISTATS , ICRA) 

C  STORE  ROSE  FORMAT  FILE  HEADERS  IN  TEMP  FILE 
C  NOTE*  WORD  257  IS  IDA,  THE  DATA  ADDRESS  FOR  EACH  EVENT 
.  ENCODE(9, 5501, MHDR)  RCV, TYPE , SNUM 

5501  .  FORMAT (3 A3 ) 

.  ENCODE (51 , 5502 ,MHDR( 11 ) )  EMM,  RKM, RUM, RERR, RLATD, RLATM, RL0ND, 
+ .  KLONM,  IDEP ,  WDEP I ,  SLATD ,  SLATM,  SLOND ,  SLONM ,  ELOER ,  SDEP ,  WDEPE 

5502  .  FORMAT (17 A3) 

.  ENCODE (21, 5503, MHDR( 35))  EXPL, SI2,BUB, SAMP, ICHN,NWDS,FNUM 

5503  .  FORMAT(7A3) 

.  BUFFER  CCT(20, MHDR, B, 257 ,MSTAT,MLEN) 

.  CALL  STATUS (20) 

C  INITIALIZE  MIN, MAX  VALUES  OF  KEYWORDS 

C 


.  IF(FNUM.BQ.l) 

.  .  INUMMX-INUM 

.  .  INUMMN-INUM 

•  .  ENUMMX-ENUM 

.  .  ENUMMN-ENUM 

.  .  DSTMAX-DST 

.  .  DSTMIN-DST 

.  .  EXPLMX-EXPL 

.  .  EXPLMN-EXPL 

.  .  DEPIMX-WDEPI 

.  .  DEPIMN-WDEPI 

.  .  DEPE MX -WDEPE 

.  .  DEPEMN-WDEPE 

.  .  IDEPMX-IDEP 

.  .  IDEPMN-IDEP 

.  .  KDEPMX-EDEP 

.  .  EDEPMN-EDEP 

•  .  XCHNMX-ICHN 

.  .  ICHNMN-ICHN 

.  .  TYPE  MX -TYPE 

.  .  TYPE  MN- TYPE 

.  .  SIZEMX-SIZE 

.  .  SIZEMN-SIZE 

•  .  RANGMX-RANGE 

.  .  RANG MN- RANGE 

.  .  ILATMX-ILAT 

.  .  HATMN-ILAT 
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481 

482 

483 

484 

485 

486 

487 

488 

489 

490 

491 

492 

493 

494 

495 

496 

497 
49  8 

499 

500 

501 

502 

503 

504 

505 

506 

507 

508 

509 

510 

511 

512 

513 

514 

515 

516 

517 

518 

519 

520 

521 

522 

523 

524 

525 

526 

527 

528 

529 

530 

531 

532 

533 

534 

535 

536 

537 

538 

539 

540 

541 

542 

543 

544 

545 

546 

547 

548 

549 

550 

551 

552 

553 

554 

555 

556 

557 

558 

559 

560 


.  .  ILONMX-ILON 

.  .  ILONMN-ILON 

.  .  ELATMX -ELAT 

.  .  ELATMN- ELAT 

.  .  ELONMX-ELON 

.  .  ELONMN-ELON 

.  END  IF 

C  NOW  COMPARE  NEW  VALUES  OF  KEYWORDS  WITH  KIN, MAX  AND  GET  NEW  MIN, MAX 
C 

.  INUMMX-MAX0  ( INUMMX ,  INUM ) 

.  INUMKN-MIN0(  INUMMN ,  INUM) 

.  ENUMMX -MAX 0(ENUMMX,  ENUM) 

.  0T[JMMN-MINO(ENUKMN ,  ENUM) 

.  DSTMAX*MAX2(DSTMAX,  DST ) 

.  DSTMIN-KIN2(DSTMIN,DST) 

.  EXPLMX-MAXO(EXPLMX,EXPL) 

.  EXPLMN-MINO  ( EXPLMN ,  EXPL ) 

.  DEPIMX-MAXO(DEPIMX, WDEPI ) 

.  DEPIMN-MINO(DEPIMN,  WDEPI) 

.  DEPEMX-MAXO(DEPEMX, VDEPE) 

.  DEPEMN«MINO(DEPEMN,WDEPE) 

.  IDEPHX«MAXO( IDEPMX , IDEP ) 

.  IDEPMN-MINO ( IDEPMN , IDEP ) 

.  EDEPMX-MAXO ( EDEPMX , EDEP ) 

.  EDEPMN-MINO ( EDEPMN , EDEP ) 

.  ICHNMX-MAXO(ICHNMX, ICBN) 

.  ICHNMN-MINOUCHNMN, ICHN) 

.  TYPE MX«MAXO(TYPEMX, TYPE) 

.  TYP  E  MN  *  MIN  0(  TYPE  MN,  TYPE  ) 

.  SIZEMX-AMAX1  (  SIZEMX,  SIZE) 

.  S  IZEMN*AM  INI  (SIZEMN,  SIZE) 

.  RANGMX-AMAXl ( RANG MX, RANGE) 

.  RANG MN- AM INI ( RANGMN , RANGE ) 

.  IlATMX-AMAXHlLATMX,  ELAT) 

.  ILATMN-AMINl  ( ILATMN ,  HAT  ) 

.  ILONMX-AMAXl  ( ILONMX,  HON ) 

.  HONMN-AMINl  ( ILONMN ,  HON ) 

•  ELATMX »  AMAX 1 ( ELATKX , ELAT ) 

.  ELATMN- AMIN  1  (  ELATMN ,  ELAT ) 

.  ELONMX -AMAX 1 ( ELONMX, EL ON ) 

•  ELONMN-AMINl ( ELONMN , ELON ) 

.  N-ICHN*NREC 

D  WRrrE(3,4112)  ENUM 

D4112  F0RMAT(1X, 'Processing  header  for  event  no.  ',16) 

.  FNUM-FNUM+1 

.  EXIT  LOOP  IF  (FNUM.GT.N7ILES) 

END  LOOP 

IF(IERR.EQ.l)  STOP  ERR 

£****★★*♦*  *********  *********  *  ***************************  ************  *** 

WRITE(3 ,41 13) 

4113  F0RMAT(/1X, 'Finished  processing  event  header  records') 

C  CHECK  FOR  INSTRUMENT  KEYWORD  VALUE  MISMATCHES 
IF  ( ILATMX .  NE .  ILATMN  ) 

.  VRITE(3 ,2000) 

2000  ,  FORMAT (IX, 'INST.  LATITUDES  ENCODED  NOT  EQUAL  FOR  ALL  EVENTS') 
END  IF 

IF  ( INUMMN .  NE .  INUMMX ) 

.  WRITE (3 , 2001 ) 

2001  .  FORMAT (IX, 'INST  #  ENCODED  NOT  EQUAL  FOR  ALL  EVENTS') 

END  IF 

IF(DEPIMN.NE.DEPIMX) 

.  WRITE(3 ,2002) 

2002  .  FORMAT (IX, 'WATER  DEPTHS  AT  INST  NOT  SAME  FOR  ALL  EVENTS') 

END  IF 

IF ( IDEPMN . NE . IDEPMX ) 

.  WRITE(3 ,2003) 

2003  .  FORMAT (IX, 'INST.  DEPTHS  NOT  SAME  FOR  ALL  EVENTS') 

END  IF 

C  CHECK  FOR  NEGATIVE  LATS  AND  LONS;  REVERSE  THEM 
C 

IF  (ELATMX.  LT.  0 . 0  .AND,  ELATMN.  LT.  0 . 0  ) 

.  TEMP*  ELATMX 
.  ELATMX-ELATMN 
.  ELATMN*  TEMP 
END  IF 

IF (ELONMX. LT. 0 .0 .AND. ELONMN. LT. 0 .0 ) 

.  TEMP- ELONMX 
.  ELONMX-ELONMN 
.  ELONMN-TEKP 
END  IF 
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C  ENCODE  KIN, MAI  KEYWORD  VALUES  INTO  TEBUF 
C 

ENCODE  (96 , 6000 ,THBUF(29  )  )  INUMMN  ,  ENUMMX ,  ENUMMN ,  DS TMAX , 
♦DSTMIN,  EXPLMX,  EXPLMN ,  DEPIMN,  DEPEMX,  DEPEMN , 

+  IDEPMN,  EDEPKX,  EDEPMN,  ICHNMX,  ICHNMN ,  TYPEMX,  TYPEMN 

6000  FORMAT (3 16 ,  2113 ,212 ,616 ,213 , 212 , 2X) 

ENCODE ( 102 ,6001 ,THBUF(61>)  SIZEKX, SIZEMN , RANG MX, RANG MN , 
+ILATHN ,  EOKMN ,  ELATMX ,  ELATMN ,  ELONMX,  ELONMN 

6001  FORMAT (10F10.4,2X) 

REWIND  20 

REWIND  LFN 
D  WRITE(3 , 202) 

D202  FORMAT (IX, 'ROW  READY  TO  PUT  OUT  ROSE  FORMAT  HEADERS+DATA" ) 
C 

C  HOW  BUILD  BOSE  FORMAT  DATA  FILE  WITH  HEADERS 

c 

C  READ /WRITE  FILE  HEADER  RECORDS  AND  DATA 
C 

LOOP(NFHES) 

.  BUFFER  IN  ( 20 , MHDR , B , 2  57  , MSTAT , HLEN ) 

.  CALL  STATUSC  20) 

.  IDA-MHDR(  257  ) 

.  WRITE (3, 101)  MHDR(3) 

101  .  FORMATC IX, 'Processing  data  for  event  #:  ',16) 

.  EXIT  LOOP  IF (MSTAT. GE. 3) 

.  BUFFER  ODTCOUTLFN, MHDR, B, 256, MSTAT, MLEN) 

.  CALL  STATUS(OUTLFN) 

.  FOR  1-1,4 
.  .  K1E0F-2 

.  .  KEOF-2 

.  .  LFN-60+I 

.  .  IPTR-1 

•  •  HEN”0 

.  .  CALL  DPOS(LFN, IDA) 

.  .  LOOP 

.  .  .  FOR  J-1,4096 

.  .  .  .  IFClPTR.  GT.  ILEN) 

.  KIEOF-KEOF 

.  EXIT  FOR  IF(KEOF.GE.3) 

. CALL  BUFIN ( LFN , IBUF , 403  2 , KEOF ) 

.  CALL  DSTAT(LFN, ISTAT, ICRA) 

.  EXIT  FOR  IF(ILEN.EQ.O) 

.  IPTR-1 

....  END  IF 
.  .  .  .  KBUF(J)-IBUF(IPTR) 

.  .  .  .  IPTR-IPTR+1 

.  .  .  END  FOR 

...  FOR  K-J.4096 
.  .  .  .  KBUF(K)-0 

.  .  .  END  FOR 

.  .  .  CALL  BUFOUT ( OUTLFN , KB UF , 409  6 , JEOF ) 

.  .  .  J-J-l 

.  .  .  ITOTAL-ITOTAL+J 

.  .  .  EXIT  LOOP  IF(R1E0F.GE.3) 

.  .  END  LOOP 

.  END  FOR 
.  ENDFILE  OUTLFN 
END  LOOP 

C  CLOSE  FILES  EXCEPT  FOR  CATALOG  FILE 
FOR  1-1,4 
.  LFN-60+I 
.  CLOSE  LFN 
END  FOR 
CLOSE  20 
CLOSE  CORLFN 
CLOSE  CXJTLFN 

WRITE(3 ,4000)  MHDR(3) ,MHDR(1) , MHDR (39 ) ,LFN 
4000  FORMAT ( '  LAST  SHOT  WRITTEN  WAS:  ',16,'  FOR  RCV  #  ', 

.16,  '  CHAN#  ',13,'  LFN  ',12) 

C  ADD  TAPE  HEADER  RECORDS  BACK  ON  TO  EVERT  CATALOG 

C 

CALL  DSTAT (  CATLFN ,  ISTATS ,  ICRA) 

IF(KRA.BQ.l) 

.  CALL  DPO S( CATLFN, ITHEAD) 

END  IF 
LOOP 

.  BUFFER  INCH, MBUF.B, 224, MSTAT, MLEN) 

.  CALL  STATUSC 11) 
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.  EXIT  LOOP  IP(MSTAT.GE.3) 

.  CALL  BUF0UT( CATLFN, MB UF ,  224,  IE  OF  ) 

END  LOOP 

CALL  DSTAT(CATLFN, ISTATS, ILAST) 

IF(KRA.NE.l) 

.  CALL  DPO  S ( CATLFN ,  2  ) 

.  CALL  BUFIN(CATLFN,MBUF,112,IEOF) 

.  KB UP ( 112)-ICRA 
.  CALL  DPO  S ( CATLFN , 2 ) 

.  CALL  BUFOUT  (CATLFN,  MB  UF , 112, IE OF  ) 

.  WRITE(3»1 121)  ICRA 

1121  .  FORMAT (IX /START  RECORD  FOR  TAPE  HEADERS  NCW:',I6) 

END  IF 

C  WRITE  CURRENT  TAPE  HEADER  TO  CATALOG  FILE  AND  CLOSE  IT 
C  ALSO  WRITE  CURRENT  TAPE  HEADER  TO  TBEAD 
CALL  DPOS(CATLFN,  ELAST) 

CALL  BUFOUT(CATLFN , THBUF , 224, IEOF ) 

BUFFER  OUT(ll , THBUF, B, 224, MS TAT, MLEN ) 

ENDFILE  11 
ENDFILE  CATLFN 
CLOSE  CATLFN 

C  PRINTED  REPORT 

c  ^  it  +  +  tici  jUUHijUUUiAAAAAAAAAAAA************1**********'**  A  ******* 

OPEN  REP 
IPG-1 

WRITE (REP, 1 )  IPG 

1  PORMATC ////T53 , 'ROSE  ARCHIVE  REPORT' , Til 4, 'PAGE  HO.  ',13) 

WRITE  (REP  2) 

2  FORMAT(//T45/* *  *  *  SUMMARY  OF  DATA  ARCHIVED  *  *  *'  , 

.T112/RUN  DATE, TIME') 

IF(KRA.NE.l) 

.  WRITE  (REP,  3)  I  DATE,  IT  IKE 

3  ♦  FORMAT (Till ,3A3 , ' ,  ',3A3) 

ELSE 

.  WRITE (REP, 4)  IDATE.ITIME 

4  .  FORMAT(T52,'<<REPLACEMENT  ARCHIVE»  ' ,  Tl  1 1 , 3A3  ,  '  ,  ',3A3) 

END  IF 

C  ENCODE  COMPONENT  TYPES  INTO  COKBUF 
ALPHA-' 

FOR  K-1,24 

*  ENCODE (3 ,6777 ,COMBUF(K))  ALPHA 

END  FOR 

FOR  K-l , ICHN 

.  FOR  J-1,8 

.  .  IF(IC(K).EQ. J) 

.  .  .  ENCODED, 6777  , COMBUFOO)  C(J) 

6777  .  .  .  FORMAT (A3 ) 

.  ,  END  IF 

.  END  FOR 
END  FOR 

C  TRANSLATE  START  TIMES  FOR  PRINTING 
CSEC-DSTMIN 
CALL  CNTITM 
FOR  1-1,5 

.  TRAY 1(1) -TRAY ( I ) 

END  FOR 
CSEC-DSTMAX 
CALL  CNTITM 

WRITE (REP ,400)  IT AP, IDS H, RDATE, EXCODE 

400  FORMAT ( //T5 , 'RARC  TAPE  #  ' ,  15 , ,  13 ,  T2  5  / DATE  RECEIVED:  ', 

+3 A3, T82, 'EXPERIMENT:  ',3A6,A2) 

WRITE (REP, 401)  ISYR, ISMO, ISDA, ISHR, ISMIN 

401  FORMAT(T5 , 'TAPE  DATA  START  TIME:  ',514) 

WRITE (REP, 402)  IFYR , IFMO , IPDA , IFHR , IFMIN 

402  FORMAT(T5 , 'TAPE  DATA  END  TIME  :  ',514) 

WRITE (REP, 403)  IID.DNAME 

403  FORMAT (/T5,' INSTRUMENT  #:  ',I4,T48, 

•►'DESIGNER:  ',9A6) 

WRITE (REP, 40 4)  IDOC, PLACE 

404  FORMAT (T5 , 'DOCUMENTATION  CODE  (YES-1):  ',A3,T48, 

•►'INSTITUTION  RECEIVED  FEW:  ',5A6) 

WRITE  (REP,  40  5)  (COMBUF(I) ,  1-1 ,10)  ,HAT,ILON 

405  FORMAT (T5,' COMPONENTS  1-10  ONLY:  ',10A2 ,T4 8, 'INSTRUMENT  LATITUDE 
+F8. 4, T80,' INSTRUMENT  LONGITUDE:  ',F10.4) 

WRITE ( REP , 406 )  IDEP,WDEPI 

406  FORMAT(T5, 'INSTRUMENT  DEPTH:  ',16,'  M.',T48, 

-►'WATER  DEPTH  AT  INSTRUMENT:  ',14,'  MSEC.') 

WRITE (REP, 407)  NFILES 

407  F0RMATCT5,  'NUMBER  OF  EVENTS:  ',14) 


721: 

722:  408 
723: 

724: 

725:  304 
726: 

727: 

728: 

729:  325 
730: 

731: 

732: 

733:  305 
734: 

735:  306 
736: 

737:  308 
738: 

739:  309 
740: 

741:  310 
742: 

743:  311 
744: 

745:  312 
746: 

747: 

748:  313 
749: 

750:  10 
751:  316 
752:  15 
753:  314 
754: 

755:  317 
756: 

7  57: 

758:  999 
759: 

760: 

761: 

762: 

763: 

764: 

765: 

766: 

767  : 

768: 

769  : 

770: 


WRITE(EEP,  408) 

FORMAT (//T 5 /EVENT  KEYWORD  MINIMUM  &  MAXIMUM  VALUES:") 
IF(NSLN.EQ.l) 

.  WRITE  (REP,  304)  TYPEMX,  SHTLR(  1 ) 

.  FORMAT (/T20/ EVENT  TYPE  ' ,  12 ,T48,"SH0T  LINE  #:  ",A6) 

END  IF 

IF(NSLN.GT.l) 

.  WRITE (REP, 325)  TYPEMX, SHTLN 

.  FORMAT(/T20 /EVENT  TYPE  " ,  12 ,T48/SHOT  LINE  #S;  ", 

+.  A6 ,9  ( "  " ,  A6  )  ) 

END  IF 

WRITE (REP, 305)  ENUMMN , ENUMMX 

FORMAT (T20 /EVENT  #S  ",T52,I6,T60,"  TO  ",I6) 

WRITE (REP, 306)  ( TRAY 1(1), 1*1, 5), ( TRAY ( I ) , I* 1 , 5 ) 

FORMAT (T20," DATA  START  TIMES  ",  514, T60,"  TO  ",16,414) 

WRITE (REP, 308)  ELATMN , ELATKX 

FORMAT(T20 /EVENT  LATITUDES  " ,T48,F10.3 ,T60 ,"  TO  ",F10.3) 

WRIT E( REP , 309 )  ELONMN , ELONMX 

FORMAT  (T20 /EVENT  LONGITUDES  "  ,T48,F10.3  ,T60,"  TO  ",F10.3) 

WRITE (REP, 310)  EDEPMN , EDEPMX 

FORMAT  (T20 /EVENT  DEPTHS  "  ,T53 , 15  ,T60 ,"  TO  ",I5,"  M") 

WRITE  (REP,  311)  DEPEMN ,  DEPEMX 

F0RMAT(T20 /WATER  DEPTHS  " ,T52, 16 ,T60,"  TO  ",I6,"  M") 

WRITE  (REP,  312)  SIZEMN ,  SIZEMX 

FORMAT(T20 /EVENT  SIZES  "  ,T53  ,F5.1  ,T60,"  TO  ",F5.1,"  KG') 

IF (EXPLMN. EQ.EXPLMX)  GO  TO  10 
WRITE(REP, 313)  EXPLMN , EXPLMX 

FORMAT(T20 /EXPLOSIVE  TYPES  " ,T56 , 12 ,T60,"  TO  ",I2) 

GO  TO  15 

WRITE (REP, 316)  EXPLMN 

FORMAT(T20 /EXPLOSIVE  TYPE  ",T48,I2) 

WRITE  (REP,  314)  RANGMN ,  RANG  MX 

FORMAT(T20, "RANGES -EVENT  TO  RCVR  " ,T52,F6.1 ,T59 TO  ",F6.1,"  KM") 
WRITE(REP, 317  ) 

FORMAT(lRl) 

CALL  ETIME 
STOP  YEA 
STOP  EOF 
END 

FUNCTION  RUP(X) 

J-IFIX(X) 

C-FLOAT(J) 

B“(X-C)*10. 

IF(B, GE. 5 ) 

.  RUP-J+1 
ELSE 
.  RUP*J 
END  IF 
RETURN 
END 
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1:  $HS 

2:  EM  3 

3:  MO  RE 

4:  $PR  MACRO  HRAMAC-  To  archive  HIG  formatted  demux  data  with 

5:  $pr  corfile.  Outputs  to  Catalog  file  and  to 

6:  $pr  an  OUTFILE  specified  by  user.  Also  will 

7:  $pr  write  archived  data  to  the  archive  tape  by 

8:  $pr  specifying  .C  option  (HRAMAC. C). 

9:  IF,  ( .NOT.  (C. SPA. A&O) )  $JC  !GEN  . 

10:  $pr  *********  you  HAVE  SELECTED  COPY  OPTION  *************************** 

11:  $PR  ENTER  NAME  OF  HEADER  FILE  (File  containing  HIG  ROSE  tape  header(s)) 

12:  $SR.  IT  #FIL 

13:  $AS  11-#FIL 

14:  $PR  TAPE  DRIVE  12 

15:  /PS  12 

16:  PR  TAPE  DRIVE  10 

17:  /PS  10 

18:  PR  TAPE  DRIVE  9 

19:  /PS  9 

20:  PR  ENTER  DRIVE  NO.  TO  RESOURCE 
21:  $SR.  IN  #NUM 
22:  SR.N  #TAP-1 

23:  $JU  1COPY  __ 

24:  1GEN  PR  *********  YOU  HAVE  SELECTED  ARCHIVE  OPTION  ***************** 

25:  PR 

26:  $PR  Did  you  build  header  files?  If  not,  ABORT  h  run  M<BCHD 

27 :  PR 

28:  $PR  ENTER  NAME  FOR  DATA  OUTFILE 

29:  SSR.IT  #FIL 

30:  $GE  #FIL  G500  M100000  P3 

31:  AS  50-#FIL 

32:  JE  318  1BIG 

33:  PR  ENTER  NAME  OF  HIG  HEADER  FILE  (H+INST  NO) 

34:  SR.IT  #HED 
35:  GE  REPORT  P3 
36:  AS  10-REPORT 
37:  GE  THEAD  PI 
38:  AS  11-THEAD 
39 :  AS  1 2-#HED 

40:  PR  ENTER  NAME  OF  ROSE  HEADER  FILE  (RE+INST  NO) 

41:  SR.IT  #HED1 
42:  AS  15-#HED1 
43:  AS  20-Sl 

44:  SPR  ENTER  NAME  OF  CORFILE 

45:  $SR.IT  #COR 
46:  AS  40-#COR 
47:  AS  6-T2 

48:  AS  30-151 2R0SE*REV CAT . B 
49:  $PR  ENTER  FIRST  DEMDX  FILE 
50:  $SR. IT  #DA 
51:  AS  61-# DA 

52:  SPR  ENTER  SECOND  DEMDX  FILE 
53:  SSR.IT  #D2 
54:  AS  62-#D2 

55:  SPR  ENTER  THIRD  DEMDX  FILE 
56:  SSR.IT  #D3 
57:  AS  63-#D3 

58:  SPR  ENTER  FOURTH  DEMDX  FILE 

59:  SSR.IT  #D4 

60:  SAS  64-#D4 

61:  1512R0SE*XBHIR0S 

62:  WI  10 

63:  CO  T2  10 

64:  FR  10 

65:  RW  11 

66:  SP  REPORT  :6 

67:  CO  REPORT  :6 

68:  PR  Archive  part  1  is  finished.  If  you  want  to  write  this  archive 
69:  PR  to  tape  immediately,  enter  COPY: 

70:  SR.IT  #QTN 

71:  IF  (#QTN . NE . "COPY" )  ME 

72:  JU  1CMIN 

73:  ! CM IN  PR  TAPE  DRIVE  12 

74:  /PS  12 

7  5:  PR  TAPE  DRIVE  10 

76:  /PS  10 

77:  PR  TAPE  DRIVE  9 

78:  /PS  9 

79:  RW  11 

80:  PR  ENTER  DRIVE  NO.  TO  RESOURCE 


81:  SSR.IN  #NOH 
82:  SR.  N  #TAP-1 

83:  1C0PY  SPR  Writing  to  a  blank  tape?  Yes  or  no: 

84:  $SR.  IT  #BLK 

85:  IF, (#TAP>1)  JO  INCT 

86:  $PR  Mount  ARCHIVE  TAPE  with  WRITE  RING- Check  screen  for  ARCTAP 

87:  $RS  4” ARCTAP  1600B  WR  WA  :#N0M 

88:  IHXT  $PR  Enter  number  of  outfiles  to  write  to  this  tape: 

89:  $SR.IN  #N0F 

90:  $SR.N  #CNT-0 

91:  IF,(#BLK-”YES")  $J0  IRES 

9  2:  151 2R0SE*XTAP0S 

93:  IRES  $SR.N  #CNT-*CNT+1 

94:  $IF ,  (#CNT>#N0F )  $J0  !REW 

95:  $PR  ENTER  NAME  OF  OUTFILE  #CNT 

96:  $SR. IT  #FIL 

97:  AS  20-#FIL 

9  8:  $  SXCOMPAR 

99:  PR  If  headers  do  not  match,  interrupt  macro  and  check  them 

100:  (WRIT  $C0  11  4  BB  TB-224  REC  1 

101:  $PR  IAPE  HEADER  FOR  #FIL  NOW  WRITTER  TO  ARCTAP 

102:  WE  4 

103:  $PR  NOW  WRITING  #FIL  TO  TAPE 

104:  CO  #FIL  4  BB  TB-4144  ALL 

105:  $PR  PAU  -  Write  next  Archive  or  Stop 

106:  $JU  IRES 

107:  IREW  $PR  WRITE  ANOTHER  TAPE?  YES  OR  NO. 

108:  SR. IT  #ANS 

109:  *TAP-#TAP+1 

110:  IF, (#ANS“"YES")  JO  1COPY 

111:  RW  4 

112:  PR  TO  DO  A  CHECK  READ  OF  THE  ARCHIVE  TAPE,  ASSIGN  10-SCREEN  OR  LISTOOT 
113:  PR  FILE  AND  RON  XDISTP.  OTHERWISE,  FREE  4,  ELIMINATE  OOTFILES, 

114:  SPR  DISMOONT  TAPE,  LOG  &  STORE 
115:  $ME 
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NAME  ROSEHD 

C  PROGRAM  'ROSEHD'  TO  ENTER  THE  ROSE  FORMAT  TAPE  HEADER  FILE  AND 
C  CERTAIN  FILE  HEADER  CHANNEL  PARAMETERS. 

C  SLL  10/11/79 

C  LAST  MODIFIED  1/29/81 
C 

DIMENSION  MBUF(256) 

INTEGER  IID( 2) , DNAME (  28)  , EXCODE ( 10) , ST IKE ( 5) , ETIME ( 5) ,NFILES(4) 
INTEGER  CPAR (  20  , 4  ) 

COMMON /HDR/  I  ID,  DNAME ,  EXCODE ,  ST  IME ,  ET IME ,  NFHES ,  CPAR 
EQUIVALENCE  (IID,MBUP) 

C 

C 

C  BUILD  TAPE  HEADER  FILE  PLUS  CHANNEL  PARAMETERS 
C 

WRITE(3 ,7990) 

7990  FORMAT ( '  HIG  (1)  OR  NON-HIG  (0)?:') 

READ(0, )  KHIG 
WRITE(3 , 8000) 

8000  FORMAT (IX, 'ENTER  ROSE  INSTRUMENT  #  (4  CHAR):') 

READ(0 , 8001 )  (IID(I), 1-1,2) 

8001  FORMAT ( 2R2) 

WRITE(3,8002) 

8002  FORMAT (IX, 'ENTER  DESIGNER  NAME  &  ADDRESS  (56  CHAR):') 

READ(0, 8003)  (DNAME(I), 1-1,28) 

8003  FORMAT( 28R2 ) 

WRITE(3 ,8004) 

8004  FORMAT ( IX, 'ENTER  EXPERIMENT  CODE  (20  CHAR):') 

READ(0,8005)  (EXCODE(I) , 1-1 ,10) 

8005  FORMATU0R2) 

WRITE(3 ,8006) 

8006  FORMAT( IX, 'ENTER  DATA  START  TIME  (YR,  MO , DA, HR, MN) -NO  SPACES,', 
+'I. E. ,  7902210530') 

READ (0,8007 )  STIME 

8007  F0RMAT(5R2) 

WRITE(  3 , 8008) 

8008  FORMAT (IX, 'ENTER  DATA  END  TIME(YR,MD,DA,HR,MN) ') 

READ(0 , 8007 )  ETIME 

WRITE (3, 8009) 

8009  FORMAT (IX, 'ENTER  #  FILES  ON  TAPE') 

READ(0, 8010)  NFILES 

8010  FORMAT (4R2 ) 

IF(KHIG.EQ.l) 

FOR  1*1,4 
.  WRITE (3, 8011)  I 

.  FORMAT( IX, 'ENTER  CODE  FOR  CHANNEL  #  ' , II , / '( 1«V, ' , 

.  '2-R, 3-T,4-P, 5-Hl ,6-H2 ,7-VW, 8-TI) ') 

.  READ(0, )  CPAR( 1 , I) 

.  WRITE(3 , 8013)1 

.  FORMAT ( IX, 'RCVR  SENSITIVITY  AT  FO ,MV/CM/SEC(CH  ',11,'):') 

.  READ(0, )  CPAR(3, I) 

.  CPAR(2,I)-0 

•  WRITE(3, 8014)1 

.  FORMAT ( IX, 'ENTER  F0,MILLIHZ(CH  ',11,'):') 

.  READ(0, )  CPAR( 4, I) 

VRITE(3  8012)1 

.  F0RMAT(1X, 'RCVR  AMPL  FREQ  CUTOFFS(HZ) ;L0W,Hl(CH  ',11,'):') 
.  READ( 0, )  CPAR( 5,1) ,CPAR(6, I) 

.  WRITE(3, 8015)1 

.  FORMAT ( IX, 'AMPL  GAIN  OF  DIG  FILTER  IN  DB(CH  ',11,'):') 

.  EEAD( 0 , )  CPAR (7 , I) 

.  WRITE(3, 8016)1 

.  FORMAT (IX, 'DIG  FILTER  CUTOFF  FREQS;  LCW,HIGH(CB  ',11,'):  ) 
.  READ( 0 , )  CPAR( 8,1) , CPAR (9 , I) 

.  WRITE(3, 8017)1 

.  FORMAT( IX, 'LOW  ORDER  BIT  IN  MICR0V0LTS(CH  ',11,'):') 

.  READ(0 , )  CPAR( 10, I) 

.  CPAR( 11 , I)-0 
.  CPAR(12,I)-0 

.  FOR  J-13,20 
.  .  CPAR(J,l)-0 

.  END  FOR 
END  FOR 
FOR  1-135,256 
.  MBUF(I)-0 
HfD  FOR 
ELSE 

FOR  1-55,256 
.  MBUF(I)-0 
END  FOR 
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8013 
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8017 


81:  END  IF 

82:  BUFFER  OUT( 15 ,MBUF, B, 256 ,MSTAT,MLEN) 

83:  CALL  STATUS(15) 

84:  ENDFILE  15  101 

85 :  STOP  PAU 

86 :  END 
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C  PROGRAM  DISCAT  TO  DISPLAY  CONTENTS  OF  TAPE  HEADER  CATALOG  AND 
C  OPTIONALLY  EVENT  CATALOG  DATA  ON  ALL  EVENTS  OF  A  GIVEN  TAPE 
C 

C  WRITTEN  BY  SHARON  LATRALLLE  HIG  363  X7796  LAST  UPDATED  4/27/82 
C  TO  COMPILE  USE  J.DISC 

C 


NAME  DISCAT 

INTEGER  CATBUF(112),THBUF(224),TRAY(7),RDATE(3),JDATE(3) 

INTEGER  IDATE ( 3  ) ,  IDAT1  (3)  ,  LDAT2 ( 3 )  , KDATE(3 ) , COMBUF (  24 ) 

INTEGER  RERR,  ELOER, BUB ,  SAMP,PNUM,  INUM,  ENUM,  CRA, C CODE 
INTEGER  WDEPI,WDEPE,  IDEP,EDEP,  ICHN,  EXPL,TYPE 
INTEGER  CATLFN , DEPIMN , DEPEMX,  DEPEMN 

INTEGER  ENUMMX, ENUMMN,EXPLMX,EXPLMN, DEPEMX, DEPEMN,  ICHNMX 

INTEGER  ICHNMN ,  TYPE  MX,  TYPEMN ,  EDEPMX ,  EDEPMN 
REAL  ILAT,  HON,  ILATMN ,  ILONMN 

DIMENSION  PLACE (5) ,DNAME(9 ) , EXCODE (4) , SHTLN( 10) 

INTEGER'S  SBT, CSEC , DST , DSTMAX, DSTMIN , TDST, TDET 
EQUIVALENCE  (CATBUF(l) , ITYPE ) , (CATBUF(2) , JTAP) , (CATBUF(3) , INUM) 
EQUIVALENCE  (CATBUF (4) , ENUM) , (CATBUF (7 ), SBT) , (CATBUF (22) ,WDEPl) 
EQUIVALENCE  (CATBUF ( 5)  ,DST)  ,  (CATBUF  (9  )  ,  SIZE)  ,  (CATBUF  ( 11 )  , RANGE) 
EQUIVALENCE  (CATBUF ( 13)  ,  HAT)  ,  ( CATBUF ( 15)  ,  IL ON)  ,  (CATBUF (17  )  ,ELAT) 
EQUIVALENCE  ( CATBUF ( 19  )  , ELON )  ,  ( CATBUF (  21 ) , EXPL ) 

EQUIVALENCE  (CATBUF ( 23 )  ,WDEPE  ),  (CATBUF ( 24)  ,  IDEP) , (CATBUF (25 ) ,EDEP) 
EQUIVALENCE  (CATBUF ( 28) , RERR) , (CATBUF ( 29 ) , ELOER) , (CATBUF (30) , BUB ) 
EQUIVALENCE  (CATBUF (31)  ,  SAMP) ,  (CATBUF (32)  ,  WDS) 

EQUIVALENCE  (CATBUF (33)  ,FNUM)  ,  (CATBUF (34)  ,NREC  ) ,  (CATBUF (35)  ,NSAM) 
EQUIVALENCE  ( CATBUF  (36)  ,  ID  EL  )  ,  (  CATBUF  (  37  )  ,  IDATl ) 

EQUIVALENCE  (CATBUF(27  ),  TYPE)  ,  (CATBUF  (67  ),  SHTL  IN) 

EQUIVALENCE  (CATBUF(26)  ,  ICHN) ,  (CATBUF (43) , COMBUF) 

EQUIVALENCE  (CATBUF ( 40 ), IDA T2) , (CATBUF (69 ) ,CCODE) 

COMMON/ IT CM /TRAY , CSEC , JULD 
DATA  CATLFN/ 30/ 


C 


2000 

1999 

1998 


1 


4000 


4001 

6000 

6001 

6002 

6003 


OPEN  CATLFN 
WRITE(3 ,2000) 

FORMAT (IX, 'INPUT  ROSE  ARCHIVE  TAPE  #  AND  DASH  #:') 

READ ( 0 , ) JTAPE , IDASH 

VRITE(3 , 1999 ) 

FORMAT (IX, 'DO  YOU  WANT  DISPLAY  OF  EVENTS  ON  THIS  TAPE?', 

+'  YES-1:') 

READ(0, )  KEYl 
WRITE(3 , 199  8) 

FORMAT (IX, 'WANT  TAPE  HEADER  BUFFERED  OUT  TO  FILE?  YES*1:') 

READ(0, )  KEY 2 
CALL  DPOS( CATLFN, 2) 

CALL  BUF IN (CATLFN, CATBUF, 11 2, IEOF) 

CRA*CATBUF( 112) 

WRITE (3,)  CRA 
CALL  DPOS( CATLFN, CRA) 

LOOP 

.  CALL  BUFIN ( CATLFN, THBUF, 224, IEOF) 

.  EXIT  LOOP  IF  (IEOF.EQ.3) 

.  DECODE (9, 4000, THBUF)  ITAP 
.  DECODE (3 ,6003 , THBUF (160) )  IDSH 

•  INEXT*THBUF( 153) 

.  FORMAT (3X, 16) 

.  WRITE(10,)  JTAPE, ITAP, INEXT 

•  IF  ( IT  AP .  EQ .  JTAPE  ) 

.  .  IF ( IDSH. NE. IDASH)  GO  TO  1 

.  .  IF(KEY2.EQ.l) 

.  .  .  BUFFER  OUT(ll, THBUF, B, 224, MSTAT,MLEN) 

.  .  .  CALL  STATU S( 11 ) 

.  .  END  IF 

.  .  DECODE (7 5, 4001, THBUF (4))  NSLN, (PLACE (I) ,1*1,5),  IDOC, 

+  .  .  (RDATE(I ) , 1*1,3) , (IDATE(I) ,I“1 ,3) , ( JDATE(I ) , 1*1,3) , 

+  .  .  (KDATE(I), 1-1,3) 

.  .  F0RMAT(I6,5A6,13A3) 

.  .  DECODE (96  ,6000 , THBUF (29 )  )  INUMMN,ENUMMX,ENUMMN,DSTMAX, 

+  .  .  DS  TMIN , EXPLMX , EXPLMN , DEPIMN , DEPEMX, DEPEMN , 

+ .  .  IDEPMN ,  EDEPMX ,  EDEPMN ,  I CHNMX,  ICHNMN,  TYPE  MX ,  TYPEMN 

.  .  FORMAT  (3 16 ,2113 ,212 ,616,2X3 ,212 ,2X) 

.  .  DECODE (102, 6 001 , THBUF (61) )  SIZEMX, SLZEMN , RANG MX, RANGMN , 

+#  .  ILATMN , ILONMN , ELATMX, ELATMN , ELONMX, ELONMN 

.  .  FORMAT (10F10. 4, 2X) 

.  .  DECODE (17 4, 6 002, THBUF (95 ) )  IID,DNAME, EXCODE, NFILES, TDST, TDET, SH 

.  .  FORMAT ( 14, 1 2A6 ,A2 ,16, 114, IX, I14,1X, 10A6) 

.  .  DE CO DE (3, 6 003 , THBUF (160) )  IDASH 

.  .  FORMAT (13) 

.  .  INEXT*THBUF(153) 

.  .  WRITE (3, 100)  INEXT 


81 

82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 
100 
101 
102 

103 

104 

105 

106 

107 

108 

109 

110 
111 
112 

113 

114 

115 

116 

117 

118 

119 

120 
121 
122 

123 

124 

125 

126 

127 

128 

129 

130 

131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 

151 

152 

153 

154 

155 

156 

157 

158 

159 

160 


100 

2001 

2002 

2500 

2003 

2004 

2005 

2006 

2007 

2008 

2009 

2010 
2011 

2012 

2013 

2014 

2015 

2016 

2017 

2018 

2019 

2020 
2021 
2022 

2023 

2024 

2025 

2026 

2027 

2028 
2029 


2030 

2031 


FORMAT ( IX , "Date  atart  address'  ',18) 

VRITE(10,2001)  ITAP , IDASB 

FORMATCIX, 'ROSE  ARCHIVE  TAPE  NO. ' , T40 , 16 , '  -',12) 
IF(NSLN.EQ.l) 

.  WRITE (10,2002)  SHTLN(l) 

.  FORMATCIX, 'SHOT  LINE  NO.',T40,A6) 

END  IF 

IF(NSLN.GT.l) 

.  VRITEC 10 ,2500)  SHTLN 

.  FORMATCIX, 'SHOT  LINE  NOS:  ',T40,A6,9('  ',A6)) 

END  IF 

VRITEC 10,2003)  PLACE 

FORMATCIX, 'INSTITUTION  RECD  TAPE  FROM' ,T40 , 5A6 ) 
VRITE(10,2004)  IDOC 

FORMATCIX, 'DOCUMENTATION  CODE;  1-YES' ,T40 , A3 ) 
VRITE(10,2005)  RDATE 

FORMATCIX, 'DATE  ARCHIVE  TAPE  RECEIVED' ,T40 ,3 A3 ) 

VRITEC 10,2006)  IDATE 

FORMAT (IX, 'DATE  ARCHIVED' ,T40 ,3 A3 ) 

WRITE (10, 2007)  JDATE 

FORMATCIX, 'DATE  LAST  UPDATED' ,T40 ,3 A3 ) 

VRITEC 10 , 2008)  KDATE 

FORMATCIX, 'DATE  LAST  ACCESSED' ,T40 ,3 A3 ) 

VRITEC 10,2009 ) 

FORMATCIX, ^«** **********  MINIMUM  &  MAXIMUM  VALUES  OF 
'KEYWORDS  *************') 

VRITEC 10 , 2010)  INUMMN 

FORMATCIX, 'INSTRUMENT  NUMBER' ,T40 , 16 ) 

VRITEC 10 ,2011 )  ENUMMN , ENUMMX 
FORMATCIX, 'EVENT  NUMBERS' ,T40 ,216) 

CSEC-DSTMLN 
CALL  CNTITM 
VRITEC 10,2012)  TRAY 

FORMATCIX, 'MINIMUM  DATA  START  TIME' ,T40 ,7 14) 

CSEC-DSTMAX 

CALL  CNTITM 

VRITEC 10 , 2013)  TRAY 

FORMATCIX, 'MAXIMUM  DATA  START  TIME' ,T40 ,7 14) 

VRITEC 10,2014)  BXPLMN , EXPLMX 
FORMATCIX, 'EXPLOSIVE  TYPES' ,T40 , 212 ) 

VRITEC 10,2015)  DEPIMN 

FORMATCIX, 'WATER  DEPTH  AT  INSTRUMENT' ,T40 , 16) 

VRITEC 10 ,2016)  DEPEMN,DEPEMX 

FORMATCIX, 'WATER  DEPTHS  AT  EVENT' ,T40,2I6) 

VRITEC 10, 2017)  IDEPMN 

FORMATCIX, 'INSTRUMENT  DEPTH' ,T40 , 16) 

VRITEC 10 ,2018)  EDEPMN , EDEPMX 
FORMATCIX, 'EVENT  DEPTHS' ,T40 ,216 ) 

VRITEC 10 , 2019 )  ICHNMN , ICHNMX 
FORMATCIX, '#S  OF  CHANNELS' , T40 ,213 ) 

VRITEC10.2020)  TYPEMN , TYPEMX 
FORMATCIX, 'EVENTS  TYPES' ,T40 , 212 ) 

VRITEC 10 ,2021 )  SIZEMN , SIZEMX 
FORMATCIX, 'EVENT  SIZES' ,T40 ,2F10. 4) 

VRITE(10,2022)  RANG MN , RANG MX 
FORMATCIX, 'RANGES', T40,2F10. 4) 

VRITEC 10,2023)  ILATMN 

FORMATCIX, 'INSTRUMENT  LATITUDE' ,T40 ,F10. 4) 

VRITEC 10 ,2024)  ILONMN 

FORMAT ( 1 X ,' IN  STRUMENT  LONG ITUDE ' , T40 , F 1 0 . 4 ) 

VRITEC 10 ,2025)  ELATMN , ELATMX 

FORMATCIX, 'EVENT  LATITUDE  RANGE' ,T40,2F10.4) 

WRITE (10, 2026)  ELONMN , ELONMX 

FORMATCIX, 'EVENT  LONGITUDE  RANGE ' , T40 , 2F 1 0 . 4 ) 

VRITEC  10,2  0  27) 

FORMATCIX,'*****  TAPE  HEADER  FILE  CONTENTS  **★**') 
VRITE(10,2028)  IID,DNAME 

FORMATCIX,' IN STR.  #',T20,I4,'  DESIGNER' ,T40 ,9 A6 ) 

VRITEC 10,2029 )  EXCODE, NFILES 

FORMATCIX, 'EXPERIMENT:', T15,3A6,A2,'  #  OF  EVENTS:', 
T50 , 16) 

CSEC-TDST 

CALL  CNTITM 

VRITEC 10,2030)  TRAY 

FORMATCIX, 'TAPE  DATA  START  TIME' ,T40, 714) 

CSEC-TDET 

CALL  CNTITM 

WRITEC 10,2031)  TRAY 

FORMATCIX, 'TAPE  DATA  END  TIME' ,T40 ,714) 

EXIT  LOOP 


103 


161 

162 

163 

164 

163 

166 

167 

168 

169 

17  0 

171 

17  2 

17  3 

174 

17  3 

17  6 

177 

17  8 

179 

180 

181 

182 

183 

184 

183 

186 

187 

188 

189 

190 

191 

192 

193 

194 

195 

196 

197 

198 

199 

200 

201 

202 

203 

204 

205 

206 

207 

208 

209 

210 

211 

212 

213 

214 

215 

216 

217 

218 

219 

220 

221 

222 

223 

224 

225 

226 

227 

228 

229 

230 

231 

232 

233 

234 

23  5 

236 

237 

238 

239 

240 


.  END  IF 
END  LOOP 


C 

C  DISPLAY  EVENT  CATALOG  CONTENTS  IF  REQUESTED 
C 


JJ-0 

IF(KEYl.EQ.l) 

.  CALL  DPO  S ( CATLFN , INEXT ) 

.  LOOP 

•  .  CALL  BUFIN ( CATLFN ,  CATBUF ,  1 1 2 ,  IEOF  ) 


C 

C4999 


1000 

1001 


1002 


.  .  EXIT  LOOP  IF  (IEOF . EQ. 3 ) 

DECODE(9, 4999, CATBUF)  ITYPE.JTAP 
FORMAT (13 , 16 ) 

•  .  EXIT  LOOP  IF  (ITYPE.EQ.2) 

.  .  IF(JTAP.EQ.JTAPE) 

.  .  .  JJ-JJ+1 

.  .  ,  EXIT  LOOP  IF  (JJ. GT. NFILES) 

.  .  .  WRITE(10 , 1000) 

.  .  .  F0RMAT(1X, '*++++++*  EVENT  CATALOG  LIST  ********* 

.  .  .  WRITE (10, 1001)  ENUM, INTO, SHTLIN 

.  .  .  FORMAT (IX, "EVENT  NO. " ,T20, 16 , "  INSTRUMENT  NO." 

.  .  .  T50 , 16 ,T62 ,A6 ) 

.  .  .  CSEC-DST 

.  .  .  CALL  CNTITM 

.  .  .  VRITE( 10 ,1002)  TRAY 

.  .  .  FORMAT (IX, "DATA  START  TIME" ,T40 ,7 14) 


) 


1003 


1004 
15 

1005 
20 

1006 


1007 

1008 


1009 


1010 


1011 


1012 


1013 


1014 


CSEC-SBT 
CALL  CNTITM 
VRITE(10,1003)  TRAY 

FORMAT (IX, "EVENT  INSTANT  TIME" , T40 ,7 14) 

IF (TYPE. EQ. 1 )  GO  TO  15 
WRITE( 10 , 1004)  SIZE 

FORMAT (IX, "EVENT  SIZE  (KG) " ,T40 ,F10.4) 

GO  TO  20 

WRITE( 10, 1 005)  SIZE 

FORMAT( IX, "EVENT  MAGNITUDE  ",T40,F10.4) 

WRITE ( 10, 1006)  RANGE 

FORMAT( IX, "EVENT  TO  INSTRUMENT  RANGE  (KM)", 

T40 ,F10.4) 

WRITE(  10, 1 007  )  ILAT ,  HON 

F0RMAT(1X, "INSTRUMENT  LAT, LON" ,T40 .2F10.4) 

WRITE( 10 , 1 008)  ELAT , EL ON 

FORMAT (IX, "EVENT  LAT, LON" ,T40 ,2F10.4) 

IF (TYPE , EQ. 2) 

.  WRITE( 10, 1009 )  EXPL 
.  FORMAT (IX, "EXPLOSIVE  TYPE" , T40 , 14 ) 

END  IF 

WRITE(10,1010)  WDEP I , IDEP 

FORMAT (IX, "WATER  DEPTH  AT  IN STRUMENT (MSEC ), INST  DEPTH ( M ) " , 
T50 ,216) 

WRITEdO, 1  011 )  WDEPE , EDEP 

FORMAT (IX, "WATER  DEPTH  AT  EVENT (M ), EVENT  DEPTH (M)", 

T5 0,216) 

WRITEdO ,  1012)  TYPE 

FORMAT (IX, "EVENT  TYPE;  1 “EARTHQUAKE,  2-SHOT  ", 

T40 , 14 ) 

WRITEdO, 1013)  RERR,ELOER 

FORMAT (IX, "ERROR  EST.IN  RANGE (M) " ,T40 , 16 , 

/"  ERROR  RADIUS  IN  EVENT  LOCATION' ,T40 , 16) 

IF(TYPE. EQ. 2) 

.  WRITEdO, 1014)  BUB 

.  FORMATdX,  "BUBBLE  PULSE  PERIOD  (MSEC)"  ,T40 , 16) 


1015 
1023 

1016 

1017 

1018 
1044 
1019 


END  IF 

WRITEdO, 1015)  ICHN 

F0RMAT(1X,  "NUMBER  OF  CHANNELS"  ,  T40 , 14) 

WRITEdO, 1023)  (COMBUF(I), 1-1,10) 

F0RMAT(1X,  "CHANNEL  CODES  (O-NO  CHANNEL)-  CHANNELS  1  TO  10: 
T40 ,1013) 

WRITEdO, 1016)  SAMP 

FORMATdX,  "SAMPLE  RATE  IN  SAMP/SEC"  ,T40 , 16) 

WRITEdO, 1017)  WDS 

FORMATdX,  "NUMBER  OF  WORDS/RECORD  (SHOULD", 

'  -4096" ,T40 , 16) 

WRITEdO, 1018)  NREC 

FORMATdX,  "NUMBER  OF  RECORDS /COMPONENT "  ,T40 , 16) 

WRITEdO, 1044)  NS  AM 

FORMATdX,  "NUMBER  OF  SAMPLES  IN  LAST  RECORD"  ,T40 , 16) 
WRITEdO,  1019)  FNUM 

FORMATdX,  "FILE  #  WITHIN  TAPE"  ,T40 , 16) 

WRITE(10, 1020)  IDEL 


241 

242 

243 

244 

243 

246 

247 

248 

249 

250 


1020 

1021 

1022 


.  -  .  FORMAT (IX, "DELETE  KEY  ( 1 “DELETED) " ,T40 , II ) 

.  .  .  WRITE( 10,1021 )  IDAT1 

.  .  .  FORMAT ( LX, "DATE  LAST  UPDATED" ,T40 ,3A3 ) 

.  .  .  VRITE(10,1022)  IDAT2 

.  .  .  FORMAT ( IX, "DATE  LAST  ACCESSED" ,T40 ,3 A3 ) 

.  .  END  IF 

.  END  LOOP 
END  IF 
STOP  PAU 
END 
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C  PROGRAM  LISHDR  LISTS  ALL  THE  CATALOG  FILE  TAPE  HEALERS 
C 

C  LAST  MODIFIED  4/27/82  BY  SLL 

C  AS  30-CATALOG 

C  AS  1 O-LISTOUT 

C 

NAME  LISHDR 

INTEGER  CATBUF(112) , THBUF (224) ,  TRAY  1(7 ) , TRAY (7 ) ,RDATE(3) , JDATE(3) 
INTEGER  IDATE (  3 ) ,  KDATE  ( 3  ) 

INTEGER  CRA 

INTEGER  CATLFN , DEPIMN , DEFEMX  ,  DEPEMN 

INTEGER  ENUMMX,  ENUMMN, EXPLMX,EXPLMN, DEFEMX, DEPEMN,  ICHNMX 
INTEGER  ICHNMN , TYPE MX, TYPE MN , EDEPMX , EDEPMN 
REAL  ILATMN ,  HONMN 

DIMENSION  PLACE (5) ,DNAME (9 ) , EXCODE (4) ,SHTLN(10) 

INTEGER *6  CSEC.DSTMAX, DSTMIN , TDST, TDET 
COMMON / IT CM /TRAY , CSEC , JULD 
DATA  CATLFN/ 30/ 

C 


OPEN  CATLFN 

CALL  DPOS( CATLFN, 2) 

CALL  BUFIN ( CATLFN , CATBUF, 1 1 2 , IEOF ) 

CRA-CATB07(112) 

WRITE(3 ,1010) 

1010  FORMAT ( '  LIST  BY  TAPE  (1)  OR  BY  INSTRUMENT  (2):') 


READ(3 , )  KBY 
CALL  DP0S( CATLFN, CRA) 
ICNT-10 
LOOP 

.  xf(icnt.eq*io) 

ICNT-0 

IF(KBY. EQ. 2 ) 

.  WRITE( 10 ,3001 ) 
3001  .  .  .  FORMAT(/'  INSTRUM. 

+.  .  .  '  EVENTS 


LATITUDE  LONGITUDE 
fSHOTLINES') 


#FHES', 


3000 


4000  . 

4007  . 

+  . 
+  , 

4001  . 

+  . 
+  . 

6000  . 

+  . 

6001  . 
6002  . 


.  ELSE 

.  .  VRITE( 10 ,3000) 

.  .  FORMATC/'  tape  I id  TAPE  DST  TAPE  DET  #FILES', 

.  .  'EVENTS  ARCH  DATE') 

.  END  IF 
END  IF 

CALL  BUFIN  ( CATLFN,  THBUF,  224,  IE  OF) 

ICNT-ICNT+1 

EXIT  LOOP  IF  (IEOF.EQ.3) 

DECODE (9, 4000, THBUF)  ITAP 
FORMAT (3X, 16) 

DECODE(3 ,4007 , THBUF (160) )  IDASH 
FORMAT ( 13 ) 

DECODE (7 5, 4001, THBUF (4))  NSLN, (PLACE (I ) , 1-1 , 5 ) , IDOC, 

(RDATEd ) ,  1-1 , 3 ) ,  (IDATE(I)  ,1-1,3)  ,  ( JDATE(I)  ,1-1,3), 

(KDATE(I), 1-1,3) 

FORMAT ( 16, 5 A6, 13 A3) 

DECODE (96, 6000, THBUF( 29))  INUMMN , ENUMMX , ENUMMN , DSTMAX, 

DSTMIN , EXPLMX , EXPLMN , DEPIMN , DEPEMX, DEPEMN , 

IDEPMN , EDEPMX , EDEPMN , ICHNMX , ICHNMN , TYPE MX, TYPEMN 
FORMAT(3I6, 2113, 212, 616, 213, 212, 2X) 

DECODE (102, 6001, THBUF(61))  SIZEMX, SI2EMN , RANGMX, RANGMN, 

ILATMN ,  HONMN ,  ELATMX,  ELATMN ,  ELONMX,  ELONMN 
FORMAT(10F10.4,2X) 

DECODE ( 17 4 , 6 002 , THBUF (9 5 ) )  I ID , DNAME , EXCODE , NFILES, TDST, TDET , SHTL N 
FORMAT ( 14 , 1 2A6 , A2 , 16, II 4, IX, II 4, IX, 10A6 ) 


.  IF(KBY.EQ.l) 

:  SKIP  TIME  CODE  FOR  KBY- 2 
.  .  CSEC-TDST 

.  .  CALL  CNTITM 

.  .  FOR  J-1,7 

.  .  .  TRAY1(J)-TRAY(J) 

.  .  END  FOR 

.  .  TRAY1(1)-TRAY1(1)-1900 

.  .  JULD 1 -JULD 

.  .  CSEC- TDET 

.  .  CALL  CNTITM 

.  .  TRAY(1)«TRAY(1)-1900 

.  .  WRITE(10,2501)  ITAP, IDASH, IID,TRAY1(1) , JULD1 ,TRAY1(4) ,TRAY1(5) , 

+.  .  TBAY(l) , JULD, TRAY (4) , TRAY ( 5 ) , NFILES, ENUMMN, ENUMMX, IDATE 

2501  .  .  FORMAT (13 , '  12,15 ,413 ,2J, 413, 2X, 15,16,'  16, 2X, 3A3) 

.  ELSE 

.  VRITE(  10 ,2502)  I  ID,  ILATMN,  HONMN,  NFILES,  ENUMMN,  ENUMMX,  NSLN 

2502  .  .  FORMAT ( 18 ,2F 12.4, 110, 2X, 16, '  »  ',16,110) 

.  END  IF 


81: 

END  LOOP 

82: 

STOP  PAU 

83: 

END 
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C  PROGRAM  RDHDR  TO  READ  THE  CATALOG 
C 


fc  *******  *-*■ 


EVENT  HEADERS 

-*****★**  ******■**■«- 


■irk 


C  LAST  UPDATED  6/16/82 

C 

C 


*[*****★*■’**■**■★* 


NAME  RDHDR 

INTEGER  COMBUF( 24) , CATBDT (112) ,  JBUF (112) , INUM, ENUM 
INTEGER  CATLFN,  TAPENM, ICSEL( 8) , ISTAT(2) ,FNUM 
INTEGER  RERR,  ELOER, BUB,  SAMP,  TRAY (7  ), TYPE,  CCODE 
INTEGER  VDEPI,VDEPE,  IDEP,EDEP,  ICHN,  HDLFN ,  EXPL 


REAL  ELAT,  HON 

COMMON  /ITCM/TRAY , CSEC, JULD 

EQUIVALENCE  ( JBUF(l) ,CATBUF(1) ) 

( C ATBUE ( 1 ) , JTYPE ) , ( CATB UP ( 2 ) t TAPE NM ) , ( C ATB UF ( 3 ) ,  INUM ) 
(CATBUF(4) ,ENUM) , (CATBUF ( 5) ,  DST ) ,  (CATBUF (7  ) , SBT) 

(CATB UE (9 ) , SIZE ),( CATB UF ( 1 1 ), RANGE ) 

( CATBUF ( 1 3 ) , ILAT ) , ( CATB UF ( 1 5 ) # ILON ) , ( C ATB UF ( 17 ) , ELAT ) 
(CATBUF (19  )  , ELON)  ,( CATBUF (21)  , EXPL) ,( CATBUF (22)  ,WDEPI 
EQUIVALENCE  ( CATBUF ( 23 )  , WDEPE  )  ,  ( CATBUF ( 24)  ,  IDEP )  ,  ( CATBUF (25)  , EDEP 
EQUIVALENCE  (CATBUF(26)  , ICHN)  ,  (CATBUF ( 27  )  >TYPE) 

(CATBUF  ( 28 ),  RERR ),(  CATBUF  ( 29  ),  ELOER ),( CATBUF  ( 30 ),  BUB ) 
(CATBUF (31) , SAMP) , (CATBUF (3 2) ,MWDS) 

^ _  (CATBUF (33) ,FNUM) , (CATBUF (34) ,NRC ) , (CATBUF (35) ,NSAM) 

EQUIVALENCE  (CATBUF (36)  ,  IDEL) ,  (CATBUF (37  ) ,  IDATE) 

EQUIVALENCE  (CATBUF (40)  ,  IDATl  )  ,  ( CATBUF ( 43 ) ,  COMBUF ) 

EQUIVALENCE  (CATBUF(67  )  t  SHTLIN) ,  (CATBUF  (69  )  ,  CCODE  ) 

DATA  LFNS/10/.HDLFN/30/ 


EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 


EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 


) 

) 


C 


100 


1 

1000 


mi 


1100 

3 

101 


102 


99 


CALL  BTIME 
OPEN  HDLFN 
VRITE(3 ,100) 

FORMAT ( '  ENTER  START  ADDRESS  AND  NO.  OF  EVENTS  TO  DISPLAY:  ) 
READ ( 0 , )  LAD, NREC 
IF(IAD.EQ.O)  IAD*4 
IDT-0 

CALL  DPOS( HDLFN , IAD) 

WRITE(LFNS, 1000) 

FORMAT (IX, '  RECORD  TAPE#  INST#  EVENT  FNUM') 

LOOP (NREC) 

.  CALL  BUF IN (HDLFN, CATBUF, 11 2, IE OF) 

.  EXIT  LOOP  IF  (IEOF.EQ.3) 

.  IF(IDT.EQ.l) 

.  .  CSEC-DST 

.  .  CALL  CNTITM 

,  .  WRITE(LFNS,1U1)  TAPENM,  INUM, ENUM, FNUM,  (TRAY(I) ,  1-2,5) 

.  .  FORMAT (416 ,16, '/ ',12,14," 12) 

.  .  GO  TO  3 

.  END  IF 

.  WRITE (LFNS, 1100)  TAPENM, INUM, ENUM, FNUM 
.  FORMAT (416) 

END  LOOP 
WRITE(3,101) 

FORMAT( '  GO  AGAIN?  IF  NO  ENTER  -1,  IF  SO  ENTER  START  ADDRESS:  ) 
R£AD(  0, )  LAD 
VRITE(3 ,102) 

FORMAT ( '  DISPLAY  TIME?  Y-1,!M>:') 

READ( 0, )  IDT 

IF(IAD.LT.O)  GO  TO  99 

GO  TO  1 

CALL  ETIME 

ENDFILE  LFNS 

STOP 

END 
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NAME  F IX 

C  PROGRAM  TO  FIX  THE  ROSE  ARCH VIE  CATALOG  EVENT  HEADER  RECORDS 
C  WRITTEN  7/8/80  S.  LATRAILLE  LAST  MODIFIED  12/6/82 

C 

INTEGER  GETLIN,CLINE(72) ,GETWRD, EOF, ARG( 4) , CTOI,FNDFLG 
INTEGER  CRA,  CRAS  ,  CATBOT(112)  ,  THBUF ( 224)  , CATLFN 
INTEGER*6  ISTS 

COMMON /BUFER/  THBUF, CATLFN , LFN 
DATA  CATLFN/30/,LFN/20/, EOF/10003/ 

C 


OPEN  CATLFN 
OPEN  LFN 
WRITE(3,5) 

5  FORMAT/  Program  XFIX  for  fixing  the  Rose  archive  catalog 
file  event  headers  ",/"  Enter  (1)  to  change  a  small", 

+"  number  of  events;",/"  Enter  (2)  to  apply  same  fix  to  , 

+  '  all  events:',/"  ENTER  3  TO  READ  FROM  EXTERNAL  FILE") 
READ( 0, )  ITYP 
VRITE(3,10) 

10  FORMAT//"  Enter  Rose  Archive  Tape  Numbers  To  Edit:(l  2  3 
NIL-GETLIN(CLINE,0) 

CALL  DPOS( CATLFN, 2) 

CALL  BUF IN (CATLFN, CATBUF , 112, IE OF) 

CRA£*CATBOT (112) 

WRITE(3 , 15) 

15  FORMAT ( '  Enter  single  dash  #,  or  0  for  all  dash  #s:") 

READ( 0, )  KDSH 

C  WRITE  TITLES  TO  REPORT  FILE 
WRITE (LFN , 6001 ) 

6001  FORMAT (///"  CAT  EVENT  HEADER  FIX  LIST") 

ITEM-1 

WHILE(GETVRD(CLINE,  ITEM,  ARG).NE.  EOF) 


c  locat: 


1001 


1002 

c 


20 


88 


40 


K*1 

CALL  DP0S(CATLFN,CRAS) 

JTAPE*CT0I(ARG, K) 

FNDFLG-0 
INDEX*0 
HEADER 
LOOP 

CALL  BOTIN  (CATLFN,  THBUF ,  224 ,  IEOF) 
CALL  DSTAT(CATLFN, ISTS, CRA) 

EXIT  LOOP  IF(IEOF. GE.3) 

DECODE (9, 1001, THBUF)  ITAP 
FORMAT (3X, 16) 

IF  ( ITAP .  EQ .  JTAPE  ) 

.  DECODE (3 , 1002, THBUF ( 160) )  INDEX 
.  FORMAT (13 ) 

INDEX* INDEX+1 

.  WRITE (3, 20)  ITAP, INDEX 
.  IF  (KDSH. NE. 0) 

.  .  IF ( INDEX* NE. KDSH)  GO  TO  88 

.  END  IF 

.  VRITE(LFN, 20)  ITAP, INDEX 
.  FORMAT(/"  Tape  16 , II ) 

.  FNDFLG*1 
.  IF(ITYP.EQ.l) 

.  .  CALL  CFIX4(CRA) 

.  END  IF 
.  IF  ( ITYP .  EQ .  2  ) 

.  .  CALL  CFIX5(CRA) 

•  END  IF 
.  IF  ( ITT? .  EQ  •  3  ) 

•  .  CALL  CFIX8(CRA) 

.  END  IF 
END  IF 

END  LOOP 

IF  (IE  OF.  GE*3  *AND.FNDFLG*  EQ.  0) 

.  WRITE(3,40)  JTAPE 

.  WRITE (LFN, 40)  JTAPE 
.  FORMAT("  ***ERROR:  TAPE  NUMBER",  16/ 
END  IF 
.  ITEW-ITEM+1 
END  WHILE 
STOP 
END 


NOT  FOUND") 


SUBROUTINE  CFIX4(CRA) 

C  LAST  MODIFIED  11/30/82 

COMMON  /BUFER/  THBUF, CATLFN, LFN 
COMMON  /ITCM/  TRAY, CSEC, JULD 
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REAL  ARAY(6) 

INTEGER  CATBUF  (112),  CATLFN ,  THBUF  (224)  ,  ENUM ,  1ST  AT  ( 2 ) 

INTEGER  TRAY  (7  )  ,  IDATE  (3)  ,  IWD( 10)  ,EF ,  FNUM,  CRA 
INTEGER*6  CSEC,CS,CS1 

EQUIVALENCE  (CATBUT  ( 1 ) ,  ITYPE  )  ,  ( CATBUF (  2 ) ,  JTAP )  ,  (  CATBUF  ( 3 ) ,  INUM) 
EQUIVALENCE  (CATBUF (4)  ,ENUM) ,  (CATBUF ( 5)  , CS)  ,  (CATBUF (7  )  ,CS1 ) 
EQUIVALENCE  (CATBUF (9 ) , ARAY (1) ) , (CATBUT (33) ,FNUM) 

EQUIVALENCE  (CATBUF  ( 26  )  ,ICHN)  .(CATBUF  (67  )  ,  SHTLN) 

CALL  DATE (IDATE) 

DECODE (6 ,4001 , THBUF (121) )  NFILES 
4001  F0RMAT(I6) 

INEXT-THBUF(153) 

WRITE(3  ,95) 

95  FORMAT  ( *  FILE  #S  (1)  OR  EVENT  #S  (2)?') 

RRAD( 0, )  KKEY 
VRITE(3 , 1 00) 

100  FORMAT( "  ENTER  BEG  AND  END  FILE  OR  EVENT  NUMBERS:  ) 

READ( 0, )  IBEG, IEND 

WRITE(3,101) 

101  FORMAT ( "  ENTER  #  OF  WORDS  TO  BE  CHANGED:", 

+/'  MAXIMUM  IS  10") 

EEAD(0 , )  N 
VRITE(3 ,102) 

102  FORMAT ( "  ENTER  WORD  #S  (Wl  W2  W3  .  . 

+/'  WORDS  37-42  NOT  ALLOWED*  See  file  EVENT  for  word  list.") 
EEAD( 0, )  (IWD(I ) , I“1 ,N) 

C  POSITION  TO  EVENT  HEADERS 

CALL  DPO S ( CATLFN , INEXT ) 

ICRA-INEXT 
LOOP (NFILES) 

•  CALL  BUFIN( CATLFN, CATBUF, 11 2, IE OF) 

*  LRA-ICRA 

.  IF(KKEY.EQ.2) 

.  .  EF-ENUM 


C 


ELSE 

.  EF-FNUM 
END  IF 

IF(EF.GE. IBEG. AND. EF*LE. IEND) 

.  FOR  1*1 , N 
.  .  K-IWD(I) 

.  .  IF(K. GT.4.AND.K.LT.21 .OR.K. GT.42.AND.K.LT.69 ) 


SPECIAL  HANDLING 


IF(K.EQ.5) 

.  CSEC-CS 
.  CALL  CNTITM 
.  WRITE ( 3, )  TRAY 
*  READ(0, )  TRAY 
.  CALL  ITMCNT 
.  CS-CSEC 
END  IF 
IF(K.EQ.7 ) 

.  CSEC-CSl 
.  CALL  CNTITM 
.  WRITE(3 , )  TRAY 
.  READ(0, )  TRAY 
.  CALL  ITMCNT 
.  CS1CSEC 
END  IF 


C 

C 

C 

C 

C 

C25 

C 

c 

c 

c 

c 


107 


no 


IF(K. EQ.9 ) 

J«1 

WRITE ( 3 , 1 07 ) FNUM, ENUM, K, ARAY ( J ) 

LOOP 

READ(40 ,125)  ISN, SIZ 
F0RMAT(I4 ,41X, F10.3) 

EXIT  LOOP  IF ( ISN. EQ.  ENUM) 

END  LOOP 
ARAY(J)-SIZ 
WRITE(3 ,125)  ISN, SIZ 
END  IF 

.  .  .  .  IF(K.GE.9 .AND.E.LE. 19) 

.  J-(K-9)/2+l 

.  WRITE(3 ,107 )FNUM, ENUM,K, ARAY( J) 

.  FORMAT ( "  FILE", 14,"  EVENT", 15,"  WORD" , 13 ,2X,F10. 

* . "NEW  VALUE") 

. READ(0, )  ARAY(J) 

.  .  .  .  END  IF 
....  IFU.EQ.43) 

.  WRITE(3 ,110)  ENUM 

.  FORMAT ( '  EVENT  ",I5) 

.  FOR  J*1 , ICHN 

.  WRITE(3 ,109 )  J , CATBUF ( J+42 ) 
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.  .  FORMATC'  CHAN' ,I3,2X,I3, '  ENTER  CODE:') 

.  .  R£AD(0,)  CATBUF (J+42 ) 

.  END  FOR 

EKD  IF  111 

IFOUEQ.67) 

.  VRITE(3,104)  ENUM,  SHTLN 

104  .  FORMATC'  EVENT, SHTLN: ',  16 ,1X,  A6  ,  '  ENTER  SHOTLINE  N 

.  READ(0,8002)  SHTLN 

8002  . FORMATCA6) 

•  •  •  *  END  IF 

•  .  .  ELSE 

C  REGULAR  HANDLING 

.  .  .  .  VRITE(3,105)  FNUM , ENUM , K , CATB UF ( K ) 

105  .  •  a  .  FORMATC'  F#  '  ,  13 ,  ' EVENT' ,  15 ,  '  VORD(',I2,')  -',17,'  E 

+  a  a  a  a  'NEW  VALUE  I  ' ) 

.  .  .  a  READ(0,)  catbuf(k) 

a  a  a  END  IF 

a  a  END  FOR 

.  .  CALL  DPOS(CATLFN, LRA) 

.  •  FOR  L-1,3 

.  .  .  CATBUF  (  L+3  6  )  -  IDATE  ( L  ) 

.  .  .  CATB UF ( L+39 )- IDATE ( L ) 

a  a  mi  D  FOR 

.  .  CALL  BUFOUT( CATLFN,  CATBUF,  112,  IEOP) 

.  END  IF 

.  CALL  DSTAT(CATLFN, ISTAT, ICRA) 

END  LOOP 

99  CALL  DPOS( CATLFN, CRA) 

RETURN 

END 

SUBROUTINE  CFIX5(CRA) 

C  THIS  SUBROUTINE  ALLOWS  MAKING  WORD  CHANGES  TO  ALL  EVENTS 
C 

C  LAST  MODIFIED  4/20/82 

COMMON  /BUFER/  THBUF, CATLFN, LFN 
COMMON  /ITCM/  TRAY,CSEC,JULD 
REAL  ARAY ( 6 ) , REAL ( 6 ) 

INTEGER  CATBUF(112), CATLFN, THBUF(224), ENUM, ISTAT(2) 

INTEGER  TRAY ( 7 ) , IDATE ( 3 ) , IWD (10),IC(24), CRA 
INTEGER*6  CSEC,CS,CS1 

EQUIVALENCE  (CATBUF(l)  ,  ITYPE)  ,  (CATBUF(2) ,  JTAP) ,  (CATBUF(3) ,  INUM) 

EQUIVALENCE  (CATBUF (4) ,ENUM) , (CATBUF(5) ,CS) , (CATBUF (7 ) ,CS1 ) 

EQUIVALENCE  (CATBUF (9 ) ,ARAY(1) ) 

EQUIVALENCE  (CATBUF(26)  ,  ICHN)  ,  (CATBUF(67  )  .SHTLN) 

CALL  DATE (IDATE) 

DECODE (6, 4001, THBUF(121))  NFILES 
4001  FORMAT(I6) 

INEXT- THBUF ( 153 ) 

LCNT-0 

WRITE(3,101) 

101  FORMAT('  ENTER  #  OF  WORDS  TO  BE  CHANGED:', 

+/'  MAXIMDM  IS  10') 

READ(0, )  N 
WRITE (3, 102) 

102  FORMAT ( '  ENTER  WORD  *S  (W1  W2  W3  .  •  .):', 

+/'  **  See  file  EVENT  for  word  list.', 

+/'  NOTE:  The  following  words  are  not  allowed  -  ', 

+/'  Word  *s  4,5,7,11,17  ,19,23,25,30,33,37  ,39.') 

READ(0, )  (IWD(I) , I-l ,N) 

WRITE(3,100)  IWD 

100  FORMAT ( '  WORDS  ENTERED :', 1 0 14 ) 

C  CALL  CHECK(N.IWD) 

C  POSITION  TO  EVENT  HEADERS 

CALL  DPOS( CATLFN,  INEXT) 

I CRA- INEXT 
LOOP(NFILES) 

.  CALL  BUFIN( CATLFN, CATBUF, 112, IEOF) 

.  LRA- ICRA 
.  FOR  1-1 ,N 
.  .  K-IWD(I) 

.  .  IF(K.GT.4.AND.K.LT.21.0R.K. CT.42.AND.K.LT.69) 

C  SPECIAL  HANDLING 

.  .  .  IF(K.GE.9 .AND.K.LE.15) 

.  .  .  .  J-(K-9 )  /  2+1 

.  .  .  .  IF(LCNT.EQ.O) 

.  WRITE(3,107)ENUM,K,ARAY(J) 

107  .  FORMAT ( '  EVENT', 15,'  WORD' ,13 .2X.F10.4, '  ENTER  NE 

.  READ(0, )  ARAY(J) 

.  REAL(I)-ARAY(J) 
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FI  SF 

1  !  .  ARAY ( J ) “REAL ( I ) 

.  .  END  IF 

•  END  IF 
.  IF(K. EQ.43) 

.  .  WRITE (3,110)  ENDM 

.  .  FORMAT ( '  EVENT  ',15) 

.  .  FOR  J-1,ICHN 

.  .  .  IF(LCNT.EQ.O) 

.  .  .  .  VRITE(3 ,109 )  J , CATBUFC J+42) 

.  .  .  .  FORMAT ( '  CHAN '  ,  13 , 2X ,  13 ,  '  ENTER  CODE:') 

.  .  .  .  READ(0,)  CATBUFC  J+42) 

.  .  .  .  IC(J) -CATBUF (J+42) 

.  .  .  ELSE 

.  .  .  .  CATBUF (J+42)-IC(J) 

.  .  .  END  IF 

.  .  END  FOR 

.  END  IF 
.  IFOUEQ.67) 

.  .  IF(LCNT.EQ.O) 

.  .  .  WRITE(3,104)  ENTJM,  SHTLN 

.  .  .  FORMATC'  EVENT, SHTLN: ',16, IX, A6 , '  ENTER  SHOTLINE  N 

.  .  .  READ(0,8002)  SHTLN 

.  .  .  F0RMAT(A6) 

.  .  .  SL  IN  E- SHTLN 

.  .  ELSE 

.  .  .  SHTLN* SLINE 

.  .  END  IF 

.  END  IF 
ELSE 


C  REGULAR 


105 


HANDLING 

IF(LCNT.EQ.O) 

.  WRITE(3 ,105)  ENUM,K,  CATBUF (K) 

.  FORMAT('  EVENT', 15,'  WORD (',12,' 
.  READCO,)  CATBUF (K ) 

.  THBUFCl)-CATBUF(K) 

ELSE 

.  CATBUF  00«THBUF(  I) 

END  IF 
END  IF 
END  FOR 
LCNT-1 

CALL  DSTATCCATLFN, ISTAT, ICRA) 

CALL  DPOSCCATLFN , LRA) 


-',17,'  ENTER  NEW 


.  FOR  L-l ,3 

.  .  CATBUF (L+36)«IDATE(L) 

.  .  CATBUF (L+39 )-IDATE(L) 

.  END  FOR 

.  CALL  BUFOUTCCATLFN, CATBUF, 112, IEOF) 
END  LOOP 

99  CALL  DPOSCCATLFN, CRA) 

RETURN 

END 


1:  SUBROUTINE  CFIX8(CRA) 

2:  C  LAST  MODIFIED  9/25/82  TO  READ  TIME  &  EVENT  SIZE 

3:  C  AND  OTHER  PARAMETERS  FROM  SORTSLN  FILE  -  ASSIGN  40  TO  IT 

4:  C  CS-DATA  START  TIME,  CSl -EVENT  TIME 

5:  COMMON  /BUFER/  THBUF , CATLFN , LFN 

6:  COMMON  /ITCM/  TRAY , CSEC, JULD 

7:  INTEGER  CATBUF ( 1 12 ), CATLFN, THBUF (224) ,ENUM, IS TAT (2) 

8:  INTEGER  TRAY (7 ) ,  H)ATE(3) , EDEP , WDEPE , EXP , CRA 

9:  INTEGERS  CSEC,  CS,  CSl 

10:  EQUIVALENCE  ( CATBUF ( 1 )  ,  ITYPE  )  ,  ( CATBUF C  2)  ,  JTAP )  ,  ( CATBUF ( 3 )  ,  INUM ) 

11:  EQUIVALENCE  (CATBUF (4) ,ENUM) , (CATBUF (5) ,CS) , (CATBUF (7 ) ,CS1 ) 

12:  EQUIVALENCE  (CATBUF(9 ), SIZE), (CATBUFC 11) , RANGE ), (CATBUF (25) , EDEP) 

13:  EQUIVALENCE  (CATBUFC17) , ELAT), (CATBUF (19) ,ELON) ,( CATBUF (21) , EXP) 

14:  EQUIVALENCE  (CATBUF (23)  ,WDEPE ), (CATBUF (30)  ,IBUB) 

15:  EQUIVALENCE  (CATBUF (26)  , ICHN)  , (CATBUF (67 )  , SHTLN) 

16:  REWIND  40 

17:  CALL  DATE(IDATE) 

18:  DECODE (6, 4001, THBUF( 121))  NFILES 

19:  4001  FORMATCI6) 

20:  IN  EXT- THBUF  ( 153 ) 

21:  WRITE(3 ,100)  _ 

22:  100  FORMAT('  ENTER  BEG  AND  END  EVENT  NUMBER:') 

23:  READ(0,)  IB EG, IE ND 

24:  C  POSITION  TO  EVENT  HEADERS 
25:  CALL  DPOSCCATLFN, INEXT) 

26:  ICRA- INEXT 
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LOOP(NFLLES) 

•  CALL  BUFIN(CATLFN,  CATBUF,  112,  IE  OF) 

.  LRA'ICRA 

.  IF(ENUM.  GE.  IB  EG.  AND.  ENUM.LE.  IEND)  113 

C  SPECIAL  HANDLING  -  EVENT  TIME  AND  DST,  AND  SIZE 

1  .  .  READ(40 ,777 )  ISN, (TRAY(KK) ,KK-1 ,5) , SEC, ELAT, ELON, SIZE, REDEP 

*►.  .  IVDEMS ,  IBtJB ,  EXP 

777  .  .  FORMAT ( 14 , 5 13  ,F7*3,F9.4,F10.4,F10.3,F6.1,I6,I5,I2) 

.  .  EDEP*  INT  (  REDEP  ) 

.  .  WDEPE*INT(IWDEMS*1 *5) 

.  .  IF(ISN. NE.ENUM)  GO  TO  1 

C  SEC  -SEC+1.95 

C  TRAY(6)-IFIX(SEC) 

C  TRAY(7)-IFIX(SEC*1000.)-(TRAY(6)*1000) 

C  CALL  ITMCNT 

C  CSl-CSEC 

C  CS-CS1-10000 

.  .  GO  TO  15 

C  REGULAR  HANDLING 
15  .  .  CALL  DPOS(CATLFN,LRA) 

.  .  FOR  L-1,3 

.  .  .  CATBUF(L+36)«IDATE(L) 

.  .  .  CATBUF(L+39)«IDATE(L) 

.  .  END  FOR 

.  .  CALL  BUFOUT ( CATLFN , CATBUF ,  1 1 2 ,  IE  OF ) 

•  END  IF 

.  CALL  DSTAT(CATLFN,ISTAT,ICRA) 

END  LOOP 

99  CALL  DPOS( CATLFN ,  CRA) 

RETURN 

END 
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1 :  NAME  ROSED 

2:  C  PROGRAM  TO  EDIT  THE  ROSE  ARCHIVE  CATALOG  TAPE  HEADER  RECORDS 
3!  C  WRITTEN  7/1/80  S.  LAT&AILLE  LAST  UPDATED  5/13/82 


A:  C 
5:  C** 
C 
C 
C 


trtrlrk  *  ********* ***********************  ********* 


****************** 
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69 

70: 

71: 

72: 

73: 

74: 

75: 

76: 

77: 

78: 

79: 


100 


10 


11 


6001 


Assignments:  30-Catalog  file 
20-List  out  file 

INTEGER  tapno( ioo) ,eof, arg(4) ,ctoi,fndflg 

INTEGER  CRA, CRAS , CATBUF( 112) , THBUF (224) , CATLFN 
INTEGER *6  ISTS 

COMMON/BUFER/  THBUE , CATLFN , LFN 
DATA  CATLFN / 3 0/ , LFN/ 20/ ,EOF/10003/ 

OPEN  CATLFN 
OPEN  LFN 

VRITE(3 ,5)  _  , 

FORMATS  Program  XROSED  for  editing  the  Rose  archive  catalog  , 
file  tape  header  records;  Rev  4,  5/13/82  ) 

WRITE(3,100) 

FORMATC'  Enter  #  of  tapes  to  edit:') 

READ ( 0 , )  KTN 

WRITE(3 , 10)  ,  wv 

FORMATC//'  Enter  Rose  Archive  Tape  Numbers  To  Edit: Cl  2  3  •  .  •;  ) 

READ( 0, )  (TAPNO(J),J-l,KTN) 

WRITE(3,11) 

FORMATC/'  Enter  dash-number,  or  0  if  all:  ) 

READ(0,)  IDSH 
CALL  DPOS( CATLFN, 2) 

CALL  BUF IN ( CATLFN , CATBUF , 1 1 2 , IE  OF ) 

CRAS-CATBUF( 112) 

WRITE  TITLES  TO  REPORT  FILE 

WRITE (LFN , 6001 )  „  N 

FORMATC///'  CATALOG  FILE  EDIT  REPORT  ) 

ITEM-1 
K-l 

WHILE  (KTN.GT.0) 

.  CALL  DPOS( CATLFN , CRAS ) 

JTAPE-TAPNO(R) 

FNDFLOO 
INDEX-0 
C  LOCATE  HEADER 
LOOP 

CALL  BUFIN ( CATLFN , THBUF , 224 , IE0F ) 

CALL  DS TAT (CATLFN, IS TS,CRA) 

EXIT  LOOP  IFCIEOF.GE.3) 

DECODE (9, 1001, THBUF)  ITAP 
FOEMAT(3X, 16) 

DECODE (3, 1002, THBUF (160) )  IDASH 
FORMAT ( 13 ) 

IF ( ITAP .  EQ . JTAPE .AND. IDSH . EQ . 0 ) 

.  GOTO  2 
END  IF 

IF(  ITAP.  EQ.  JTAPE.  AND.  IDSH. EQ.  IDASH) 

.  CRA-CRA-2 

.  WRITE(3 ,20)  ITAP, IDASH 
.  WRITE (LFN, 20)  ITAP, IDASH 
.  FORMAT ( / '  Tape  , 16 , , II ) 

.  FNDFLG-1 
.  CALL  GATED (CRA) 

.  CALL  CATMM(CRA) 

END  IF 
END  LOOP 
K-K+l 
KTN-KTN-1 

IF(IEOF. GE.3 .AND.FNDFLG. EQ.0) 

.  WRITE(3 ,40)  JTAPE, IDSH 

.  WRITE  (LFN,  40)  JTAPE,  IDSH  ,  „ 

FORMATC'  ***ERR0R:  TAPE  NUMBER', 16,  -  ,13,  NOT  FOUND  ) 

END  IF 
ITEM-  ITEM+1 
END  WHILE 
STOP 
END 

SUBROUTINE  GATED  (CRA) 

C  Subroutine  used  with  program  ROSED  to  edit  the  standard  ROSE 
C  header  part  of  the  Catalog  tape  header  record. 

C 
C 


1001 

1002 


20 


40 


LAST  MODIFIED  4/26/82  BT  S.  LATRAILLE 
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123 

124 
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127 

128 
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C  ****  NOTE:  ADDED  A  LIKE  (AFTER  CALL  TO  DSTAT  TO  DETERMINE 
C  POSITION  IN  CATALOG  AFTER  WRITING)  TO 

C  REPOSITION  BACK  TO  BEGINNING  OF  CURRENT  RECORD 

C 

COMMON /BUFER/  THBUF ,  CATLFN ,  LFN 

INTEGER  CRA,  THBUF (224)  ,RDATE(3)  , ADATE (3)  , UDATE(3)  , CDATE(3) 
INTEGER  TRAY (7 ) , CATLFN , IDATE(3) 

COMMON  /  ITCM/TRAY ,  CS  EC ,  JULD 
INTEGERS  TDST ,  TDET,  CSEC ,  ISTS 

DIMENSION  PLACE (5) , DNAME (9 ) , SHTLN( 10) , EXCODE (4) 

C 

C 


7000 


7010 

7011 
1 

1000 


1001 


50 

2001 


2 

2002 


3 

2003 

3003 

4 

2004 

3004 

5 

2005 

3005 

6 

2006 


7 

2007 


8 

2008 

3008 

9 

2009 


CALL  DATE ( IDATE ) 

DECODE (84, 7 000, THBUF)  JTYPE, IT AP, NSLN, PLACE, IDO C, 

+RDATE ,  ADATE ,  UDATE ,  CDATE 
FORMAT ( 13 , 2 16 , 5A6 , 1 3 A3 ) 

DECODE (17  4,7 010, THBUF (9 5)  )  IID, DNAME,  EXCODE,  NFILES, 

+TDST, TDET, SHTLN 

FORMAT ( 14 , 1 2A6 ,A2 , 16, 114, IX, 114, IX, 10A6) 

DECODE (3 ,7011 , THBUF ( 160) )  IDASH 
FORMAT(I3 ) 

VRITEO,  1000) 

FORMAT('  Enter  the  number  of  the  variable  you  want  to  change.', 

+/'  Only  one  can  be  entered  at  a  time,  but  program  will  loop', 

+'  to  do  more', 

+/'  If  ALL,  enter  0;  if  PAU,  enter  99:') 

VRITEO, 1001) 

FORMATC// '  1  -  Tape  No.  5  -  Date  rcvd.  9  -  No.', 

+'  of  files', 

+/'  2  -  No.  Shotline  #s  6  -  Date  archived  10  -  Tape  data', 

+'  start  time', 

+/'  3  -  Inst,  rcvd  from  7  -  Instrument  I.D.  11  -  Tape  data', 


♦'  end  time', 

+/'  4  -  Document,  code  8  -  Designer  name  12  -  Shotline', 

+'  designation',/'  13  -  Dash  no. (position  on  archive  tape') 

RKAD(3 , )  KGOTO 
IF(KGOTO.EQ.O)  GO  TO  50 
IF (KGOTO. EQ. 9 9 )  GO  TO  99 

GO  TO  (50, 2, 3,4, 5,6, 7, 8,9, 10, 11, 12, 13), KGOTO 
VRITEO, 2001)  ITAP 

FORMAT( '  Archive  tape  no. ',14,'  Enter  tape  no.:') 

READ(0, )  ITAP 
IF(KGOTO)  99,, 99 
VRITEO, 2002)  NSLN 

F0RMAT('  Number  of  shotline  #s:',I6,'  Enter  number:') 

READ( 0 , )  NSLN 
IF (KGOTO)  99,, 99 
VRITEO, 2003)  PLACE 

F0RMAT('  Institute  reed  f rom: ',5A6 , /'  Enter  institute  (30  char):') 
R£AD(0 ,3003)  PLACE 
FORMAT (5A6) 

IF(KGOTO)  99,, 99 
VRITEO, 2004)  I  DOC 

FORMAT ( '  Documentation  code:', A3,'  Enter  doc.  code:') 

READ( 0,3004)  IDOC 
F0RMAT(A3 ) 

IF(KGOTO)  99,, 99 
VRITEO, 2005)  KDATE 

F0RMAT( '  Date  Arch,  tape  reed: ',3A3,/'  Enter  date:  ') 

READ(3 ,3005)  RDATE 
FORMAT (3 A3) 

IF (KGOTO)  99,, 99 
VRITEO, 2006)  ADATE 

FORMAT ( '  Date  archived: ',3A3,/'  Enter  date:') 

READ( 0,3005)  ADATE 
IF (KGOTO)  99,, 99 
VRITEO  ,2007  )  I  ID 

FORMAT ( '  Instrument  ID#:  ',16,'  Enter  ID  #;') 

READ(0, )  I ID 
IF (KGOTO)  99,, 99 
VRITEO  ,2008)  DNAME 

FORMAT('  Designers  name  &  address : ',9 A6 ,/'  Enter  name  &  address:') 
READ(0,3008)  DNAME 
FORMAT ( 9 A6) 

IF (KGOTO)  99,, 99 
VRITEO, 2009)  NFILES 

F0RMAT( '  Number  of  files  (events)  on  tape:  ',16, 

♦/'  Enter  number  of  files:') 

READ(0,)  NFILES 
IF (KGOTO)  99,, 99 
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17  0 
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17  2 
17  3 
17  4 
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202 
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204 

205 

206 
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208 
209 


10  CSEOTDST 
CALL  CNTITM 

WRITE(3 ,2010)  (TRAY (I), 1-1,5) 

2010  FORMAT/  Tape  data  start  time:  ',514,/"  Enter  data  start  time 
R£AD( 0, )  (TRAY(I), 1-1,5) 

CALL  ITMCNT 
TDST-CSEC 
IF(KGOTO)  99 ,  ,99 

11  CSEC-TDET 
CALL  CNTITM 

VRITEC3 ,2011 )  (TRAY(I), 1-1,5) 

2011  FORMAT/  Tape  data  end  time:  ',514,/'  Enter  data  end  time:') 
READ(0, )  (TRAY(I), 1-1,5) 

CALL  ITMCNT 
TDET-CSEC 
XF(KGOTO)  99,, 99 

12  WRITEC3 ,2012 )  SHTLN 

2012  FORMAT/  Shotline  designs tion( s ):', 10A6 ,/ '  Enter  shotline(s) 
+'60  char. ') 

READ(0,3012)  SHTLN 
3012  FORMATC 10A6) 

IF(KGOTO)  99,, 99 

13  WRITE (3 ,2013 )  IDASH 

2013  FORMATC'  Dash  no., or  position  on  tape:', 13,/'  Enter  dash  no.: 
READC0,)  IDASH 

99  WRITEC3 ,2015) 

2015  FORMATC'  PAL  WITH  EDIT?  YES-1:') 

READC0,)  LEND 
IF(IEND.NE.l)  GO  TO  1 
FOR  1-1,3 

•  UDATE  C I ) -IDATE ( I ) 

.  CDATECI)-IDATE(I) 

END  FOR 

C  ENCODE  CHANGED  AS  WELL  AS  OLD  VALUES  INTO  THBUF 

EN CODE  (  84  ,7  000 ,  THBUF )  JTYPE ,  ITAP ,  NSLN ,  PLACE ,  IDOC , 

+RDATE , ADATE , UDATE , CDATE 

ER CODE (17  4,7010, THBUF (95))  IID,DNAME, EXCODE, NFILES, 

+TDST,  TDET,  SHTLN 
ENCODE ( 3 ,7011 ,THBUF( 160) )  IDASH 
C  POSITION  TO  CURRENT  RECORD  AND  REWRITE  IT 
CALL  DPO S  C  CATLFN , CRA ) 

CALL  BUFOUTC CATLFN, THBUF, 224, LEOF) 

CALL  DPO S( CATLFN, CRA) 

CALL  DSTATC CATLFN, ISTS, CRA) 

WRITE (LFN, 6000)  ITAP, IDASH, IDATE, KGOTO 
6000  FORMATC'  CATALOG  FILE  HEADER  FOR  ARCHIVE  TAPE  #',I6, 

+  '-',13/  EDITED', 

+  '  AND  REWRITTEN  TO  REV  CAT  ON  ',3A 3,'  -  LAST  CHANGE  13) 

999  RETURN 
END 


210;  c***^**^***  *  ********* *+++*•**+++ 

211:  SUBROUTINE  CATMM(CRA) 


212: 
213: 
214: 
215: 
216: 
217: 
218: 
219: 
220: 
221: 
222: 
223: 
224: 
225: 
226: 
227  : 
228: 
229: 
230: 
231: 
232: 
233: 
234: 
235: 
236: 
237  : 
238: 
239: 
240: 


C 

C  Subroutine  to  edit  the  HIG  added  part  of  the  header 

C 

C  LAST  MODIFIED  5/13/82  S. LATRALLLE 

C 

COMMON /BUFER/  THBUF, CATLFN, LFN 

INTEGER  CRA, THBUF ( 224 ) , ENUMMX , ENUMMN , DEPEMN , DEPEMX, EDEPMN 
INTEGER  TRAY (7 ) , CATLFN, EDEPMX,WDEP I, IDATEC3) 

REAL  LLAT,  LLON 
COMMON / IT CM /TRAY , CS E C , JULD 
INTEGER *6  CSEC, ISTS ,DSTMAX,DSTMIN 
C 
C 

CALL  DATE (IDATE) 

DECODEC9, 5999, THBUF)  ITAP 

5999  FORMAT(3X,I6) 

DECODE (9 6, 6 000, THBUF (29))  INUM, ENUMMX, ENUMMN , DSTMAX, 

+DSTMIN, JXPLMX , JXPLMN , WDEP I , DEPEMX , DEPEMN , 

+IDEP ,  EDEPMX ,  EDEPMN ,  ICHNMX ,  ICHNMN ,  JTYPMX,  JTYPMN 

6000  FORMATC3I6, 2113, 212, 616, 213, 212, 2X) 

DECODEC  102, 6001, THBUFC61))  SI2EMX, SIZEMN, RANGMX, RANGMN, 

+LLAT ,  HON,  ELATMX ,  ELATMN ,  ELONMX ,  ELONMN 

6001  FORMATC 10F10. 4, 2X) 

C 

1  WRITE(3,1000) 

1000  FORMATC'  Enter  the  number  of  the  variable  you  want  to  change. 
+/'  Only  one  can  be  entered  at  a  time,  but  program  will  loop', 
+'  to  do  more', 

+/'  If  ALL,  enter  0;  if  PAH,  enter  99:') 


241 
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246 
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255 
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257 
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27  0 
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27  6 
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282 
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288 

289 
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299 
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301 
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320 


WRITE (3 ,1 001) 

1001  FORMATC  //"  1  -  I  ID  No.  8  -  Max  Shot  Depth  15  -  Max', 

+'  range', 


+/'  2  -  Kin  Shot  # 

9  -  Water  dep  recv 

16  -  Inst 

» 

+  "  latitude", 

+/"  3  -  Max  Shot  # 

10  -  Kin 

WD  at  shot 

17  -  Inst 

> 

+  "  longitude", 

+/ "  4  -  Kin  Start  Time 

11  -  Max 

WD  at  shot 

18  -  Kin 

shot" 

+"  latitude", 

+/"  5  -  Max  Start  Time 

12  -  Min 

shot  size 

19  -  Max 

shot" 

+"  latitude", 

+/"  6  -  Recv  Depth 

13  -  Max 

shot  size 

20  -  Kin 

shot" 

+"  longitude", 

♦/"  7  -  Kin  Shot  Depth 

14  -  Kin 

range 

21  -  Max 

shot" 

+'  longitude', 

+/T48,'22  -  Event  header  addr') 

READC3 , )  KGO 
IF(KGO.EQ.O)  GO  TO  50 
IFCKG0.EQ.22)  GO  TO  22 
IFCKGO. EQ.99 )  GO  TO  99 

GO  TO  (50, 2, 3, 4, 5, 6, 7, 8,9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21), KGO 
50  WRITE (3, 2001)  INUM 

2001  FORMATC'  Instrument  I.D.  no. ',14,'  Enter  I.D.  no.:') 

READ(0, )  INUM 

IF(KGO)  99,, 99 

2  WRITEC3 ,2002)  ENUMMN 

2002  FORMATC'  Min  shot  #:',I6,'  Enter  number:') 

READC0, )  ENUMMN 

IP(KGO)  99, ,99 

3  WRITE(3 ,2003)  ENUMMX 

2003  FORMATC '  Max  shot  #:',I6,'  Enter  number:') 

READ( 0, )  ENUMMX 

IF(KGO)  99  ,  ,99 

4  CSEC-DSTMIN 
CALL  CNTITM 

WRITEC3 ,2010)  (TRAYCl ) , 1-1 ,5) 

2010  FORMATC'  Min  data  start  time:  ',514,/'  Enter  data  start  time:') 
READC0, )  (TRAYCl ) , 1-1 ,5) 

CALL  ITMCNT 
DSTMIN-CSEC 
IF(KGO)  99,, 99 

5  CSEC-DSTMAX 
CALL  CNTITM 

WRITEC3 ,2011 )  (TRAYCl), 1-1,5) 

2011  FORMATC'  Max  data  start  time:  ',514,/'  Enter  data  start  time:') 
READ(0, )  (TRAYCl), 1-1,5) 

CALL  ITMCNT 
DSTMAX-CSEC 
IF (KGO)  99,, 99 

6  WRITEC3 ,2004)  IDEP 

2004  FORMATC'  Recv  depth:', 16,'  Enter  recv  depth:') 

READC0, )  IDEP 

IF(KGO)  99,, 99 

7  WRITEC3.2005)  EDEPMN 

2005  FORMATC'  Min  event  depth :', 16 ,/ '  Enter  depth:  ') 

READC3,)  EDEPMN 

IF(KGO)  99,, 99 

8  WRITE(3,2006)  EDEPMX 

2006  FORMATC'  Max  event  depth :', 16 ,/ '  Enter  depth:') 

READC0,)  EDEPMX 

IF(KGO)  99,, 99 

9  WRITEC3.2007)  WDEPI 

2007  FORMATC'  Water  depth,  recv:  ',16,'  Enter  water  depth:') 

READC0,)  WDEPI 

IF(KGO)  99,, 99 

10  WRITEC3 ,2008)  DEPEMN 

2008  FORMATC'  Min  water  depth  at  event : ',16,/'  Enter  depth:') 

READC0, )  DEPEMN 

IF(KGO)  99,, 99 

11  WRITE(3,2009)  DEPEMX 

2009  FORMATC'  Max  water  depth  at  event:  ',16, 

+/'  Enter  depth:') 

READC0,)  DEPEMX 
IF(KGO)  99,, 99 

12  WRITEC3.2012)  SIZEMN 

2012  FORMATC'  Min  shot  sire: '.F10.4,/'  Enter  sire:') 

READ(0, )  SIZEMN 

IF(KGO)  99,, 99 

13  WRITEC3.2013)  SIZEMX 

2013  FORMATC'  Max  shot  sire: ',F10.4 , '  Enter  sire:') 
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341 
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343 

344 

343 
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347 

348 
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351 
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353 

354 

355 

356 
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368 
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14 

READCO,)  sizemx 

IF(KGO)  99,, 99 

WRITE(3,2014)  RANGMN 

2014 

FORMATC'  Min  range : ',F10.4 , ' 

Enter  range:') 

15 

READ(0,)  RANGMN 

IF(KGO)  99,, 99 

WRITE(3,2015)  RANG MX 

2015 

FORMATC'  Max  range : ' ,F10.4, ' 

Enter  range:') 

16 

READ(0, )  RANG MX 

IF(KGO)  99,, 99 

WRITE(3,2016)  XXAT 

',F10.4,'  Enter  latitude.') 

2016 

FORMATC'  Instrument  latitude: 

17 

READCO,)  HAT 

IFCKGO)  99,, 99 

WRITEC3 ,2017 )  ILON 

2017 

FORMATC'  Instrument  longitude 

:',F10.4/  Enter  longitude:') 

18 

READCO,)  HON 

IFCKGO)  99,, 99 

WRITEC3.2018)  ELATMN 

2018 

FORMATC'  Min  event  latitude:' 

>F10.4/  Enter  latitude:') 

19 

READCO,)  ELATMN 

IF(KGO)  99,, 99 

WRITE(3 ,2019 )  ELATMX 

2019 

FORMATC'  Max  event  latitude:' 

,F10.4/  Enter  latitude:') 

20 

READCO,)  ELATMX 

IFCKGO)  99,, 99 

WRITE(3 ,2020)  ELONMN 

',F10*4/  Enter  longitude:') 

2020 

FORMATC'  Min  event  longitude: 

21 

READCO,)  ELONMN 

IFCKGO)  99,, 99 

WRITE(3,2021)  ELONMX 

'#F10.4/  Enter  longitude:') 

2021 

FORMATC'  Max  event  longitude: 

22 

READCO,)  ELONMX 

IFCKGO)  99,, 99 
IDADR-THBDF(153) 

2022 

WRITE(3,2022)  IDADR 

FORMATC'  Event  header  start  address :', 18 , '  Enter  address:') 

99 

READCO,) IDADR 

THBUFC 153) “IDADR 

WRITEC3 ,2099 ) 

2099 

FORMATC'  PAD  WITH  EDIT?  YES“1 

:') 

READCO,)  IEND 

IFClEND. NE. 1 )  GO  TO  1 

ENCODE C9 6 ,6000, THBDFC 29 ) )  INDM.ENDMMX.ENUMMN.DSTMAX, 

+DSTMIN ,  JXPLMX ,  JXPLMN ,  VDEPI ,  DEPEMX , DEPEMN , 

+IDEP ,  EDEPMX,  EDEPMN ,  ICHNMX,  ICHNMN ,  JTTPMX,  JTYPKN 
ENCODE (102,6001 ,THBUF(61))  SIZEMX, SIZEMN,  RANGMX, RANGMN, 

+ILAT,  HON ,  ELATKX,  ELATMN ,  ELONMX,  ELONMN 
CALL  DPO  S ( CATLPN , CRA ) 

CALL  BUF0UT(CATLFN,THBUF,224,IE0F) 

CALL  DSTAT(CATLFN, ISTS , CRA) 

WRITE (LFN, 8000)  ITAP, IDATE,KGO 

8000  FORMATC '  CATALOG  FILE  HEADER  FOR  ARCHIVE  TAPE  #',16/  EDITED', 
+  '  AND  REWRITTEN  TO  REV  CAT  ON  ',3A3,'  -  LAST  CHANGE  #',I3) 

999  RETURN 
END 


1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
9  : 


PROGRAM  A  D  H  E  D  TO  ADD  HEADERS  BACK  ONTO  CATALOG  FILE  AFTER  A 
PROGRAM  ABORT  OR  SYSTEM  FAILURE 

LAST  MODIFIED  5/20/81 

AS  20-THEAD,  WHICH  MUST  CONTAIN  ALL  TAPE  HEADERS  FROM 
THE  CATALOG  FILE,  AS  30- REV CAT,  WHICH  IS  MINUS 
ITS  HEADERS 
AS  20-THEAD, 30- REV CAT 


10: 

INTEGER  CATBUF(112)fTHBUF(224) 

11: 

OPEN  20 

12: 

OPEN  30 

13: 

LOOP ( 3 ) 

14: 

.  CALL  BUFIN ( 30,  CATBUF, 1 12, IEOF 

15: 

END  LOOP 

16: 

JHRA-CATBUF(112) 

17: 

WRITE(3 , 1 00)  JHRA 

18:  100 

FORMATUX,  'NOW  POSITION  TO  REC'  , ! 

19: 

CALL  DPOS( 30, JHRA) 

20: 

LOOP 

21: 

.  CALL  BUFIN ( 20, THBUF, 224, IEOF) 

22: 

.  EXIT  LOOP  IF  (IE0F.GE.3) 

23: 

.  CALL  BUFOUT(30, THBUF, 224, IEOF 

24: 

END  LOOP 

25: 

ENDFILE  30 

26: 

STOP 

27: 

END 

119 
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C  PROGRAM  ADTAPE  TO  OPTIONALLY  (1)  ADD  BACK  TAPE  HEADERS  TO  A 
C  CATALOG  PILE  WITH  DATA  RECORDS  ONLY (  THIS  COULD  HAPPEN  IF 
C  SYSTEM  CRASHES  DURING  AN  ARCHIVE  OR  IP  PROGRAM  ABORTS  DURING 
C  ARCHIVE),  OR  (2)  TO  ADD  A  NEW  TAPE  HEADER  AND  NEW  DATA  RECORDS 
C  TO  A  COMPLETE  CATALOG  FILE. 

C 

C  USE  THIS  PROGRAM  WITH  MACRO  DU P CAT 

C  LAST  MODIFIED  1/13/81  SLL 

C  ASSIGN  30-CATALOG  TO  WRITE  TO,  11-THEAD, 40- INPUT  CATALOG  FILE  FOR  OPT 
C  (UNBLKD)  (BLKD)  (UNBLKD) 

INTEGER  CATBUF(112) ,THBUF(224) ,THBUF 1(224) 

INTEGER *6  ISTAT 
OPEN  30 
OPEN  11 
OPEN  40 
WRITE(3 ,9  8) 

9  8  FORMAT ( '  PROGRAM  ADTAPE  TO  OPTIONALLY  (1)  ADD  BACK  TAPE  HEADERS' 

+/'  TO  A  CATALOG  FILE  WITH  DATA  RECORDS  ONLY(  THIS  COULD  HAPPEN', 
+/'  IF  SYSTEM  CRASHES  DURING  AN  ARCHIVE  OR  IF  PROGRAM  ABORTS  ', 
+/'  DURING  ARCHIVE),  OR  (2)  TO  ADD  A  NEW  TAPE  HEADER  AND  NEW  ', 
+/'  EVENT  HEADER  RECORDS  TO  A  COMPLETE  CATALOG  FILE.', 

+//'  ASSIGN  30-REVCAT, 11-THEAD, 40-INPUT  CATFILE  FOR  OPTION  2') 
WRITE(3 , 100) 

100  FORMATC/'  OPTION  1  (ADD  BACK  TAPE  HDRS) ; ' 

+/'  OR  OPTION  2  (ADD  NEW  TAPE  HEADER  &  DATA  RECORDS)') 
READ(0,)IOPT 
1  CALL  DP0S( 30, 2) 

CALL  BUFIN ( 30 ,  CATBUF ,  11 2 ,  IEOF) 

KRA-CATBUF( 112) 

CALL  DP0S( 30 ,KRA) 

IF(I0PT. EQ. 2 )  GO  TO  10 
LOOP 

.  BUFFER  IN(  11  ,THBUF,B, 224,MS,MLEN) 

.  CALL  STATU S( 11) 

.  EXIT  LOOP  IF(MS.GE.3) 

.  CALL  BUFOUT(30,THBUF, 224, IEOF) 

END  LOOP 
ENDFILE  30 
STOP  HEAD 

10  LOOP 

C  SAVE  OFF  TAPE  HEADERS 

.  CALL  BUFIN ( 30, THBUF, 224, IEOF) 

.  EXIT  LOOP  IF(IEOF.GE.3) 

.  BUFFER  ODT(ll, THBUF, B, 224, MS, MLEN) 

END  LOOP 
ENDFILE  11 

C  POSITION  CATALOG  FILE  TO  OLD  HEADER  START  ADDRESS 
C  THIS  ADDRESS  IS  NOW  THE  START  ADDR  OF  NEW  DATA  RECORDS 
CALL  DPO  S ( 3  0 ,  ERA ) 

WRITE(3 , 103)  KRA 

103  FORMAT ( '  NEW  DATA  ADDRES S : ' , 17 ) 

WRITE(3 , 101) 

101  FORMAT( '  ENTER  TAPE  4  AND  DASH  4  TO  BE  ADDED:') 

READ ( 0 , )  NT APE , JFN 

IDASH-JFN 
CALL  DPOS( 40 ,2 ) 

CALL  BUFIN(4C, CATBUF, 112, IEOF) 

CALL  DPO  S ( 40 , CATBUF (112)) 

C  SEARCH  SECOND  CAT  FILE  FOR  SPECIFIED  TAPE 
LOOP 


2 

CALL  BUFIN( 40, THBUF 1,224, IE OF) 

DE CODE (9,1 000, THBUF1)  ITAP 

1000 

FORMAT (3X, 16) 

DECODE (6 ,1001 ,THBUF1(121) )  NFILES 

1001 

FORMAT ( 16) 

IF(IE0F.GE.3) 

.  WRITE(3,102) 

102 

.  FORMAT ( '  TAPE  SPECIFIED  NOT  IN 

.  STOP  FILE 

END  IF 

IF  ( ITAP. EQ. NT APE) 

.  IF(JFN.NE.l) 

•  •  JFN— JFN —I 

.  .  GO  TO  2 

.  END  IF 

• 

.  EXIT  LOOP 

• 

END  IF 

END  LOOP 

C  POSITION  TO  NEW  DATA  RECORDS 
IADD-THBUF 1(153) 
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C  VRITE(3,110)  THBUF1( 153) 

C110  FORMAT ( '  DATA  ADD  IK  HDR-',I6,'  ENTER  DATA  ADD:') 
C  READ( 0, )  LADD 

CALL  DPOS( 40 ,  LADD) 

THBUF 1(153) -KRA 
LOOP  (NFILES  ) 

.  CALL  BUFIN(40 , CATBUT ,  1 1 2 ,  IEOF) 

.  EXIT  LOOP  IF(IE0F . GE. 3 ) 

.  CALL  BUFOUT( 30, CATBUT ,112, IE OF ) 

END  LOOP 

C  DETERMINE  NEW  HEADER  START  ADDRESS 
CALL  DSTAT(30,ISTAT,KRA) 

VRITE(3,120)  KRA 

120  FORMAT ( '  NEW  HDR  START  ADDRESS  IS: ',16) 

REWIND  11 
LOOP 

.  BUTTER  IN( 11 ,THBUT,  B,  224, MS , HLEN) 

.  CALL  STATDS(ll) 

•  EXIT  LOOP  IF(MS.GE.3) 

.  CALL  BUTOUT(30, THBUF, 224,  IE  OF) 

END  LOOP 

CALL  DSTAT(30,  ISTAT,  NRA) 

C  WRITE  HEADER  FOR  NEW  TAPE  TO  CATALOG 
CALL  BUFOUT ( 30 , THBUF 1 ,224, IE OF ) 

ENDFILE  30 
CALL  DPOS(30 , 1 ) 

CALL  BUFIN(30, CATBUF, 112, IEOF ) 

CATBUT (112) -KRA 

CALL  BUTOUT(30, CATBUT, 112, IEOF) 

REWIND  11 
WRITE(3 , 130) 

130  FORMAT ( '  ADD  ANOTHER  TAPE?  YES-1') 

READ( 0, )  IGO 
IF(IGO.EQ.l)  GO  TO  1 
STOP 
END 
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C  PROGRAM  DEL  HD  R  TO  DELETE  TAPE  HEADERS  PROM 
C  THE  CATALOG  FILE 
C 

C  LAST  MODIFIED  5/13/82  SLL 

C  ASSIGN  30-CATALOG  ,11-FILE  TO  SAVE  OFF  HEADERS 
C  (UNBLKD)  (BLKD) 

INTEGER  CATBUF (112), THBUF ( 224 ) , IDATE ( 3 ) 

OPEN  30 
OPEN  11 
VRITE(3,100) 

100  FORMAT(/'  ENTER  TAPE  AND  DASH  HUMBER' 

+/'  TO  BE  DELETED.  ') 

READ ( 0 , )  NT APE, IDAS H 

CALL  DPO  S ( 3  0 , 2 ) 

CALL  BUFIN(30, CATBUF, 112, IEOF) 

KRA-CATBUFU12) 

CALL  DPOS(30,KRA) 

LOOP 

C  SAVE  OFF  TAPE  HEADERS 
2  .  CALL  BUFIN(30, THBUF, 224, IEOF) 

.  IF(IE0F.GE.3)  GO  TO  5 
.  DECODE(9, 4000, THBUF)  ITAP 

4000  .  F0RMAT(3X,I6) 

.  DECODE (3 ,4001 , THBUF (160) )  IDSH 

4001  .  FORMAT (13) 

.  IF ( ITAP. NE. NT APE)  GO  TO  3 
.  IF(IDASH.NE.IDSH)  GOTO  3 
.  DECODE (9 ,40 02, THBUF (20) )  ( IDATE ( I ) , I- 1 , 3 ) 

4002  .  FORMAT (3 A3 ) 

.  VRITE(3 , 102)  ITAP, IDSH, IDATE 

102  .  FORMAT ( '  DELETE  TAPE  #  ' , 16 ,  '  DASH  ',13,'  ARCHIVED  ON 

+.  3X, 3A3 , '  ?  IF  YES  ENTER  1:') 

.  READ(0, )  IDD 
.  IF (IDD. NE. 1 ) 

.  .  GO  TO  3 

•  ELSE 
.  .  GO  TO  2 

.  BJD  IF 

3  .  BUFFER  OCT(lllTHBUF,B,224,MS,MLEN) 

END  LOOP 
5  ENDFILE  11 

C  POSITION  CATALOG  FILE  TO  START  ADDRESS  OF  HEADER  RECORDS 
CALL  DPOS( 30 ,KRA) 

REWIND  11 
LOOP 

.  BUFFER  IN(11, THBUF, B, 224, MS, MLEN) 

.  CALL  STATU  S ( 1 1 ) 

.  EXIT  LOOP  IF(MS. GE.3) 

.  CALL  BUFOUT( 30, THBUF, 224, IEOF) 

END  LOOP 
ENDFILE  30 
STOP 
END 
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C  PROGRAM  DEI  TAP  TO  DELETE  TEE  LAST  TAPE  WHICH  WAS  ARCHIVED 
C  FROM  THE  CATALOG  FILE  ALONG  WITH  ITS  DATA  RECORDS 
C 

C  LAST  MODIFIED  9/28/81  SLL 

C  ASSIGN  30-CATALOG  , 11 -TREAD  TO  SAVE  OFF  HEADERS 
C  (UHBLKD)  (BLKD) 

INTEGER  CATBUF (112), TUB DP ( 224 ) , IDATE ( 3 ) 


OPEN  30 
OPEN  11 
WRITE(3 , 1 00) 

100  FORMAT(/'  ENTER  TAPE  AND  DASH  NUMBER' 

•f/'  TO  BE  DELETED.  THIS  SHOULD  BE  THE  LAST  ONE  ARCHIVED: ' ) 
READCO, )  NTAPE , JFN 
IDASH-JFN 
CALL  DPO  S ( 3  0 , 2 ) 

CALL  BUFIN(30, CATBUF, 1 12, IEOF) 

ERA- CATBUF (112) 

CALL  DPOS(30,KRA) 

LOOP 

C  SAVE  OFF  TAPE  HEADERS 

CALL  BUFIN(30  ,THBUF , 224, IEOF) 

IF(IEOF. GE.3)  STOP  ERROR 
DECODE (9, 4000, THBUF)  ITAP 
4000  .  FORMAT (3X, 16) 

IFCITAP.EQ. NTAPE) 

.  IF(JFN.NE.l) 

.  .  JFN- JFN-1 

.  .  GO  TO  3 

.  END  IF 

.  IDADR-THBUF  (153) 

•  DECODE (9 ,4001 , THBUF (20))  (IDATE(I) , 1-1 ,3) 

.  FORMAT (3 A3) 

.  WRITE(3,102)  ITAP, IDAS H, IDATE 

.  FORMAT ('  DELETING  TAPE  #  ',16,'  DASH  ',13,'  ARCHIVED  ON' 
.  3X,3A3) 

.  GO  TO  5 
END  IF 

BUFFER  OUT(ll, THBUF, B, 224, MS, MLEN) 

END  LOOP 
5  ENDFILE  11 

C  POSITION  CATALOG  FILE  TO  OLD  DATA  START  ADDRESS 
C  THIS  ADDRESS  IS  NOW  THE  START  AD DR  OF  HEADER  RECORDS 
CALL  DP0S( 30 , IDADR) 

WRITE (3, 103)  IDADR 

103  FORMATC'  NEW  HEADER  ADDRESS :', 17 ) 

REWIND  11 
LOOP 

•  BUFFER  INCH, THBUF, B, 224, MS, MLEN) 

.  CALL  STATU S( 11 ) 

.  EXIT  LOOP  IF(MS. GE.3) 

.  CALL  BUFOUT(30, THBUF, 224, IEOF) 

END  LOOP 
ENDFILE  30 
CALL  DPOS( 30, 1 ) 

CALL  BUF IN (30, CATBUF,  112,  IEOF) 

CATBUF  (112)-  IDADR 

CALL  BUFOUT(30, CATBUF, 112, IEOF) 

STOP 

END 
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C  PROGRAM  BULLETIN  TO  WRITE  BULLETIN  FROM  SORTED  BINARY  CATALOG  FILE 
C  LAST  MODIFIED  2/21/81 
NAME  BULLETIN 

INTEGER  TRAY  (7  ) , TIME  ( 5)  ,  GATB UF (112)  , PTA? , PINUM, BENUM,  ENUM,  CRA 
INTEGER  CATLFN ,  RLFN  ,  FTAP,  FINUM,  FENTTM 
INTEGERS  CSEC  ,  BTLME ,  DST ,  ISTAT ,  FT  IKE  .ORIGIN 

EQUIVALENCE  (CATBUF(l) >  ITYPE  ) ,  ( CATBUF ( 2 )  ,  ITAP) ,  (CATBUF(3)  ,  INUM) 
EQUIVALENCE  (CATBUF (4)  , ENTTM ) ,  (CATBUF (5)  fDST)  ,  (CATBUF (67  )  ,  SHTLN, 
COMMON/ IT CM /TRAY , CSEC , JULD 
DATA  CATLFN/ 30/  , RLFN/ 10/ 


C 

C100 

C 


5001 

5002 


5003 


Nue  Instrument 

Archive" ) 


Evnt  e 
Tape  No 


I.D.  (Origin) 

.") 


Dat8 


C  CONV 


5010 


5013 


OPEN  CATLFN 
OPEN  RLFN 
WRITE( 3 ,100) 

FORMAT ("  ENTER  START  RECORD  ADDRESS:") 

READ(0,)  I CRA 
ICRA'0 
ICOUNT-O 
ISUB-0 
ITOT-0 

CALL  DPOS  ( CATLFN  ,  ICRA ) 

CALL  BUFIN  ( CATLFN ,  CATBUF ,  1 1 2 ,  IEOF ) 

FSLN-SRTLN 

CALL  DPOS  (CATLFN,  ICRA) 

WRITE (RLFN, 5001)  FSLN 

F0RMAT(  ///"  SHOTLINE  DESIGNATION:  ",A6) 

WRITE (RLFN ,5002) 

FORMAT( / /"  Event  #s 
♦"Beginning  and  Ending 
WRITE (RLFN ,5003) 

FORKAT("  Included 

♦"Start  Times 
LOOP 

CALL  BUFIN (CATLFN, CATBUF, 112,  IEOF) 

CALL  DSTAT( CATLFN, ISTAT, CRA) 

ICOUNT-ICOUNT+1 
ITOT-ITOT+l 

EXIT  LOOP  IF ( IEOF. GE. 3 ) 

IF ( ITYPE. NE. 1 ) 

.  ICOU NT* I COU NT- 1 
.  GO  TO  1 
END  IF 

IF  ( I COU  NT « EQ .  1 ) 

FSLN-SHTLN 
PSLN- SHTLN 
FTAP- ITAP 
FINUM- INUM 
FENTTM  ENUM 
FT IKE 'DST 

ELSE  IF  ( I  COU  NT .  NE .  1 ) 

IF ( INUM. NE . PINUM. OR. SHTLN. NE. PSLN. OR. ITAP. NE. PTAP ) 

TIMES  TO  INTEGER  ARRAYS 
.  CSEC-FTIME 
.  CALL  CNTITM 
.  FOR  1-1,5 
.  .  TIME ( I ) -TRAY ( I ) 

.  END  FOR 
.  CSEC-BTIME 
.  CALL  CNTITM 
.  CALL  ORID(PINUM, ORIGIN) 

.  ICT-ICOUNT-1 

.  rroT-iTOT-i  .  .  f  _ 

WRITE (RLFN ,5010)  FENUM, BENUM, ICT, PINUM,  ORIGIN  ,  (TIME  (I ),  1-1 , 5 
•  (TRAY(I),I-2,5) ,PTAP 

.  FORMAT (IX, 16, "  to" , 16 ,3X, 13 ,31, 16 , IX, A6 , 5X, 14 , 12 ,  /  ,12, IX, I 
.  12,'  to  ',12. '/ M2, IX,  12,': ',12,61,16) 

.  ISUB-ISUB  +  ICT 
.  ICOD  NT”  0 
.  CRA” CRA- 1 

.  CALL  DPOS (CATLFN, CRA) 

END  IF 
END  IF 

IF  (  SHTLN.  NE.  PSLN) 

.  WRITE(RLFN, 5013)  ISUB 
.  FORMATC/'  Subtottl' ,16) 

.  WRITE (RLFN, 5001)  SHTLN 
.  WRITE (RLFN, 5002) 

.  WRITE (RLFN, 5003) 

.  ISUB-0 
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.  END  IF 
.  PSLN-SHTLN 
•  PTAP-ITAP 

.  pinum-inum  125 

.  BENU>HENUM 
.  BTIME-DST 
END  LOOP 

CALL  ORID(PINUM,  ORIGIN) 

WRITE (RLFN,  5010)  FENUM,  BENUM,  ICT,PINUM,  ORIGIN,  (TIME(  I ) ,  I"1  *5  )  , 

+(TRAY(I),I-2,5),PTAP 
WRITE (RLFN, 5013)  ISUB 
WRITE (RLFN, 5011)  ITOT 

5011  FORMAT  ( /  II'  TOTAL  NUMBER  OF  EVENTS  PROCESSED  ',19  ) 

STOP  BULL 
END 

SUBROUTINE  ORID(IID,  ORIGIN) 

INTEGER*6  OR( 12) , ORIGIN 

DATA  OR(l)/'WHOI  '/  ,OR(  2) /'LDGO  '  f  ,OR(3)/'UTMSI  '/ 

DATA  OR(4)/'SCRIPP'/,OR(5)rUW  '/ , OR(6) / 'HIG  '! 

DATA  OR(7)/'OSU  '/ , OR( 8) /"MIT  '/ ,OR(9 ) /'UCSB  '/ 

DATA  OR(10)/'N0RDA  '/ , OR( 1 1 ) / "MIT  '/ ,OR( 12) /'NRL  '/ 

RII^FLOAT(IID)/100. 

J-IFIX(RID) 

C-FLOAT(J) 

B-RID-C 

IF(B.GT..001) 

.  J-J+l 
END  IF 
ORIGIN-OR(J) 

RETURN 

END 
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C  PROGRAM  SEARCH:  3  TO  SEARCH  THE  EVENT  CATALOG  AND  LIST  WHERE  TO 
C  FIND  REQUESTED  RECORDS 


C 

c  VERS  3  -  WRITE  BINARY  HEADERS  :::::::::::: 

C  WRITTEN  BY  SHARON  LATRAELLE  HIG  363  X7796  LAST  UPDATED  9/27/82 
C 

C  I  CRN-#  OF  CHANNELS 

C  CCODE-CODE  FOR  DUPLICATE  COMPONENT  PARAMETERS 

C  (IF  1,  ONLY  COMPONENT  1  IS  CODED) 

C  COMB  UF  “CHANNEL  CODE  BUFFER  -  CHANNELS  1  THRU  I  CRN  ARE  CODED  WITH 

C  CHANNEL  TYPE  (1  THRU  8)  AND  THE  REST,  ICHN+1  TO  24  ARE  -0. 

C  IF  CCODE-1,  CHANNELS  2  THRU  ICHN  ARE  SAME  AS  CHANNEL  1. 

C 


NAME  SEARCH 

INTEGER  COMBUFC24)  ,CATBUF(112) ,  JBUF(112)  ,CCODE,  INUM,  ENUM 

INTEGER  CATLFN ,  TAPENM,  ICSEL(  8)  ,CHSEL(  24) ,  ISTAT(2)  ,FNUM 

INTEGER  RERR,  ELOER,  BUB ,  SAMP,  TRAY (7  ) , FHDR(  256)  ,TYPE ,  HDLFN 

INTEGER  WDEP I ,  WDEPE ,  IDEP ,  EDEP ,  ICHN ,  EXP L 

REAL  HAT,  HON 

COMMON  / ITCM/TRAY , CSEC , JULD 

COMMON  /SEL/  JBUF 

EQUIVALENCE  (JBU?(1 )  ,CATBUF(1) ) 

EQUIVALENCE  (CATBUF  (1)  ,  JTYPE  ) ,  (CATBUF (2) , TAPENM)  ,  (CATBUF(3 ) ,  INUM) 
EQUIVALENCE  (CATBUF (4) ,ENUM) , (CATBUF(5) ,DST) , (CATBUF (7 ),SBT) 
EQUIVALENCE  (CATBUF (9 ) , SIZE) , (CATBUF (II ) , RANGE) 

EQUIVALENCE  (CATBUF (13)  ,  HAT) ,  (CATBUF (15) ,  HON) ,  (CATBUF (17  )  ,  ELAT ) 
EQU IVALENCE  (CATBUF  ( 19  )  ,  ELON  )  ,  (  CATBUF  (  21 ) ,  EXPL ) ,  (  CATBUF  ( 22  )  ,  WDEP  I ) 
EQUIVALENCE  (CATBUF (23)  , WDEPE  ) ,  ( CATBUF ( 24) ,  IDEP)  ,  ( CATBUF ( 25)  , EDEP ) 
EQUIVALENCE  (CATBUF ( 26)  ,  ICHN) ,  (CATBUF (27  ), TYPE ) 

EQUIVALENCE  (CATBUF ( 28)  , RERR) ,  (CATBUF (29  )  , ELOER)  ,  (CATBUF (30)  ,BUB) 
EQUIVALENCE  (CATBUF ( 31 ),  SAMP) ,  (CATBUF (32)  ,WDS) 

EQUIVALENCE  (CATBUF(33) ,FNUM) , (CATBUF (34) ,NRC) , (CATBUF (35) ,NSAM) 
EQUIVALENCE  (CATBUF (36)  ,  IDEL)  ,  (CATBUF (37  )  ,  IDATE) 

EQU  IVALENCE  (  CATBUF  (  40  )  ,  IDAT1 ) ,  (  CATBUF  (  43  )  ,  COMBUF ) 

EQUIVALENCE  (CATBUF (67) ,  SHTLIN) ,( CATBUF (69) ,CC0DE) 

LOGICAL  SELFLG 

DATA  CATLFN/30/,LFNS/40/, HDLFN/ 50/ 


C 


CALL  BTIME 
OPEN  CATLFN 
OPEN  HDLFN 

C  POSITION  TO  FIRST  EVENT  RECORD  IN  CATALOG  AREA;  ALSO  WRITE  OUTPUT  HEADLIN 
WRITE  (LFNS,  1000) 

1000  F0RMAT(1X,'  TAPE#  INST#  EVENT  FNUM  CHANNEL  SELECT  CODE  , 

+' ( 1 -SELECT ,  0-DO  NOT  SELECT)') 

CALL  DPOS( CATLFN, 2) 

CALL  BUFIN(CAHFN,  CATBUF,  112,  IE  OF) 

JHADR-CATBUF(112) 

FOR  K=1 , 24 
.  CHSEL(K)-0 
END  FOR 
NSEL-0 
NREC-0 
LOOP 

.  CALL  BUFIN(CATLFN, CATBUF, 112, IEOF) 

.  EXIT  LOOP  IF  (IEOF.EQ.3) 

.  NREC-NREC+1 

.  EXIT  LOOP  IF(SIZE.GT.l.E+06) 


CHECK  FOR  HOW  CHANNELS  ENCODED 
IF(CCODE.EQ.l) 

.  FOR  1-2, ICHN 
.  .  COMBUF ( I ) -COMBUF ( 1 ) 

•  END  FOR 
END  IF 

CALL  RECSEL(ICSEL, SELFLG) 

IF (SELFLG) 

NSEL-NSEL+1 
IF(ICSEL(1).NE.9999) 

SELECT  CHANNELS  REQUESTED 
FOR  K-1,24 
FOR  L-1,8 

.  IF(COMBUF(K)  .BQ*  ICSEL(L)  ) 
.  .  CHSEL(K)-1 

.  END  IF 
END  FOR 
END  FOR 
END  IF 

IF(ICSELd)  *EQ.9999 ) 

SELECT  ALL  CHANNELS 
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.  .  FOR  K-l.ICBN 

•  .  .  CHSEL(K)-1 

.  .  END  FOR 

.  END  IF 

.  WRITE (LFNS, 1100)  TAPENM,  INUM, ENUM, FNUM,  CHSEL 
1100  .  .  FORMAT (416 ,4X, 2412) 

C  FILL  FILE  HEADER  BUFFER 
.  FHDR(1)-INUM 
.  FHDR(2)*TYPE 
.  FHDR( 3)-ENUM 
.  CSEODST 
.  CALL  CNTITM 
.  FOR  1-1,7 
.  .  FHDR( 1+3 ) -THAT ( I ) 

.  END  FOR 
.  FHDR(ll)-0 
.  FHDR( 12)-IFIX(RANGE) 

.  FHDR( 13 )-IFIX(RANGE*1000 . )-FHDR( 12)*1000 

•  FHDR(14)-RERR 
.  FHDR(15)-IFIX(ILAT) 

•  FHDR( 16 )-IFIX(ILAT*1000.)-FHDR( 15)*1000 
.  FHDR(17)-IFIX(IL0N) 

.  FHDR( 18) -IFIX(ILON*1000. )-FHDR( 17 )*1000 
.  FHDR( 19 )-IDEP 
.  FHDR(20)«WDEPI 
.  FHDR( 21 )- IF IX (ELAT ) 

.  FHDR( 22) -IFIX( ELAT* 1000 . )-FRDR( 21 )* 1000 
.  FHDR(  23  )-IFIX(ELON ) 

,  FHDR(24)-IFIX(ELON*1000.)-FHDR(23)*1000 

.  FHDR( 25 ) -ELOER 
.  FHDR( 26 )-EDEP 
.  FHDR(  27  )  -WDEPE 
.  CSEC-SBT 
.  CALL  CNTITM 

•  FOR  1-1,7 

•  .  FHDR(I+27)«TRAY(I) 

.  END  FOR 
.  FRDR( 35 ) -EXPL 
.  IF(SIZE.GT.O.Ol)  THEN 

,  .  FHDR(36)-IFIX(ALOG10( SIZE*1000, )*1000. ) 

.  ELSE 

.  .  FBDR(36)“0 

.  .  WRITE (3, 222)  ENTO.SI2E 

222  ...  FORMAT('  EVENT  SIZE  LT  OR  -  0.01,  EVENT:  '.I6.F12.6) 

.  END  IF 
.  IF(TYPE.EQ.l) 

.  .  FHDR(36)-SIZE 

.  END  IF 
.  FHDRC37 )“BDB 

.  IF(SAMP. GT.999 )  SAMP-SAMP/100 
.  FHDR(38)-SAMP 
.  FHDR(39)-ICHN 
.  FHDR(40)-NWDS 
.  FHDR( A1 )-FN0M 
.  FHDR(60)-CCODE 
.  FOR  K-l.ICHN 
.  .  FHDR(41+K*20)-COMBDF(K) 

.  END  FOR 
.  FHDR(7 1 )-NRC 
.  FHDR(72)-NSAM 

.  BUFFER  OOT(HDLFN,FHDR,B,256,MS,ML) 

.  CALL  STATDS(HDLFN) 

END  IF 

C  ZERO  CHANNEL  SELECT  ARRAY 
FOR  >1,24 
.  CBSEL( I)-0 
END  FOR 
END  LOOP 

CALL  DSTATCCATLFN, ISTAT, JRA) 

JRA-JRA-1 
CALL  ETIME 
ENDFILE  LFNS 

WRITE(LFNS,1200)  NSEL.NREC, JHADR, JRA 
1200  FORMAT ( '  NUMBER  OF  RECORDS  SELECTED:  ',17,'  TOTAL  NUMBER  OF', 
+'  RECORDS  PROCESSED:  ',17,/'  HEADER  ADDRESS: ', 17 , 

+'  STOP  ADDRESS: ',17) 

STOP 

END 
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SUBROUTINE  RECSEL(  ICHN,  SELFLG) 

INTEGER  ICHN(8),JBUE(I12) 

INTEGER  TYRE , ENUM, EDEP, WDEPE , EXPLOS ,WDEPI , TAPENM 
INTEGER*6  STIME 
REAL  HAT,  HON 
COMMON  /SEL/  JBUE 

EQUIVALENCE  (  JBUF(2)  , TAPENM) ,  (  JBUP(3)  ,  INUM)  ,  (  JBUF(4)  ,ENUM) 
EQUIVALENCE  (JBUF(5)  ,  STIME)  ,  (JBUF(9  ),  SIZE)  ,  (JBUF(  11)  .RANGE) 
EQUIVALENCE  (  JBUF(  13)  ,  HAT)  ,  (  JBUP(  15 )  ,  HON ) ,  (  JBUF(  17  )  ,  ELAT) 
EQUIVALENCE  ( JBUF( 19 ) ,ELON) , ( JBUF(21 ) , EXPLOS) , ( JBUF(22) ,WDEPI) 
EQUIVALENCE  (  JBUF( 23  )  .WDEPE ) .  (  JBUF ( 24)  ,  IDEP ) ,  (  JBUF ( 25 ) ,  EDEP ) 
EQUIVALENCE  (  JBUF(  27  )  .TYPE  )  ,  (  JBUF(67  )  ,  SHOHN) 

LOGICAL  SELFLG, QFLAG 
FOR  1-1,8 
.  ICHN(I)-9999 

END  FOR 
LOOP ( 1 ) 

.  QFLAG-.TRUE. 

.  LOOP ( 1 ) 

.  .  EXIT  LOOP  IF  (INUM  .EQ.526) 

.  .  QFLAG  -  .FALSE. 

.  END  LOOP 

.  EXIT  LOOP  IF  (.NOT. QFLAG) 

.  LOOP ( 1 ) 

.  .  EXIT  LOOP  IF  ( SHOHN.  EQ."SLN3N  ") 

.  .  QFLAG  -  .FALSE. 

.  END  LOOP 

.  EXIT  LOOP  IF  (.NOT. QFLAG) 

END  LOOP 
IF  (QFLAG) 

«  SELFLG*  *  TRUE. 

ELSE 

SELFLG*. FALSE. 

END  IF 
BE  TORN 
END 
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C  ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 

C  PASCAL  PROGRAM  SELECT  BY  MIKE  SIMPSON 

C  I:::::;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 

CONST  129 

MAXNUMSTR  -  15; 

MAXRESWDS  *  20; 

TYPE 

TEXT  -  FILE  OF  CHAR; 

CHTP  -  (LETTER,  DIGIT,  SPECIAL,  ILLEGAL,  SIGN,  RELATION); 

NUMCASES  -  (NUMREAL,  NUMINT,  NUMDBL,  NUMTIME ,  NUMALFHA) ; 

RESVDTYPES  -  (VALID,  INVALID,  USED,  PAU,  CHANNEL) ; 

ALPHA  -  ARRAY  [  1 . . 6 ]  OF  CHAR; 

VAR 

DIAG  :  TEXT; 

CHAR TP  :  ARRAY [ CHAR ]  OF  CHTP; 

ORDINT  :  ARRAY [CHAR]  OF  INTEGER; 

SOURCE  :  ARRAY [ 1 . . 80 ]  OF  CHAR; 

INPLEN  :  INTEGER; 

CB  I  CHAR ; 

EOL  :  BOOLEAN  ; 

TEST  :  BOOLEAN; 

CHCNT  :  INTEGER; 

SCANWIDTH  :  INTEGER; 

PARAMSTRING  :  ALPHA; 

NUMSTRING  :  ARRAY[1..15]  OF  CHAR; 

NUMPTR  :  INTEGER; 

NUMTYPE  :  NUMCASES; 

REL STRING  :  ARRAY[1..2]  OF  CHAR;  (*  RELATION  STRING  *) 

RELNOT  :  BOOLEAN;  (*  FLAG  ON  NOT  RELATION  *) 

RWTYPE  :  RESVDTYPES ; 

HWSET  :  ARRAY [1.. MAXRESWDS]  OF  ALPHA; 

KWARG  :  ARRAY  [  1 .  .MAXRESWDS  ]  OF  RESVDTYPES; 

KWNUMTP  :  ARRAY  [  1 .  .MAXRESWDS  ]  OF  NUMCASES; 

PROCEDURE  NEWLINE; 

BEGIN 

IF  EOF (INPUT)  THEN  BEGIN 
WRITELN( OUTPUT, '  EOF  ****'); 

SOURCE [  1  ]  :«  'E';  S0URCE[2]  'N'; 

SOURCE [3]  'D';  S0URCE[4] 

INPLEN  :«  4; 

TEST  FALSE; 

END 

ELSE  BEGIN 
INPLEN  0; 

REPEAT  READ ( INPUT, CH); 

IF  INPLEN  <  80  THEN  BEGIN 
INPLEN  :«  INPLEN  +  1; 

SOURCE  [INPLEN]  :*  CH; 

END; 

UNTIL  EOLN( INPUT); 

READ ( INPUT, CH) ;  (*  READ  BLANK  AT  EOL  *) 

END; 

SCANWIDTH  :«  INPLEN; 

CHCNT  :*  0; 

EOL  :*  FALSE 
END  (*  NEWLINE  *); 

PROCEDURE  NEXTCH; 

BEGIN 

IF  EOL  THEN  BEGIN 
NEWLINE; 

END; 

CHCNT  :  -  CHCNT  +  1; 

EOL  :«  CHCNT  >  SCANWIDTH; 

IF  EOL  THEN  CH  '  ELSE  CH  :«  SOURCE [CHCNT] ; 

END  (*  NEXTCH  *); 

PROCEDURE  GETINTEGER; 

BEGIN 

WHILE  CHARTPlCH]  IN  [DIGIT]  DO 
BEGIN 

NUMSTRING  [NUMPTR]  CH; 

NUMPTR  : *  NUMPTR  +  1; 

NEXTCH 

END 

END;  (*  GETINTEGER  *) 

PROCEDURE  NEXT IKE; 

TYPE 

BETA  -  ARRAY[ 1 . .10]  OF  CHAR; 

VAR 

I , YRACC , LOCALACC  :  INTEGER; 

WORKS TR  :  BETA; 
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PROCEDURE  BLDNUMERIC  (VAR  NUMACC  :  INTEGER); 

BEGIN 

NUMACC  ;«0; 

WHILE  CHAR TP [CH]  IN  [DIGIT]  DO  BEGIN 
NUMACC  :«  NUKACOIO; 

NUMACC  NUMACC  +  ORDINTtCH]; 

NEXTCH 

END 

END  ;  (*  BLDNUMERIC  *) 

PROCEDURE  ADD(A,B  :  BETA;  VAR  C  :  BETA); 

VAR 

J, SUM, CARRY, DIGIT  :  INTEGER; 

BEGIN 

CARRY  :*  0; 

FOR  J  :«  10  DOVNTO  1  DO  BEGIN 
SUM  ORDINT [A[ J] ]  +  ORDINT[B[ J] ] ; 

SUM  :*  SUM  ♦  CARRY; 

DIGIT  SUM  HDD  10; 

C [ J]  :-CHR(DIGIT  +  ORD('O')); 

CARRY  SUM  DIV  10; 

END 

END;  (*  ADD  *) 

PROCEDURE  HDLT(MP1  ; INTEGER;  MP2  :  BETA;  VAR  MP3  :  BETA); 
VAR 

I , MDIGIT  :  INTEGER; 

BEGIN 

MP3  :«  '0000000000'; 

WHILE  MPl  >  0  DO  BEGIN 
MDIGIT  :«  MPl  MOD  10; 

FOR  I  :■  1  TO  MDIGIT  DO  ADD(MP2 , MP3, MP3) ; 

FOR  I  1  TO  9  DO  MP2  [  I  ]  MP2U+1]; 

MP2 [10]  :«  'O'; 

MPl  MPl  DIV  10 
END 

END;  (*  MULT  *) 

PROCEDURE  NUMTOSTR(NTSl  :  INTEGER;  VAR  NTS 2  :  BETA); 

VAR 

I, DIGIT  :  INTEGER; 

BEGIN 

FOR  I  10  DOVNTO  1  DO  BEGIN 
DIGIT  :«  NTS  1  MOD  10; 

NTS2 [ I ]  :«  CHR(DIGIT  +  ORD('O')); 

NTS 1  :«  NTSl  DIV  10 
END 

END  ;  (*  NUMTOSTR  *) 

PROCEDURE  ADDACC(MULPY  :  INTEGER); 

BEGIN 

IF  CH  *  ' , '  THEN  BEGIN 

WHILE  NOT(CHARTP[CH]  IN  [DIGIT])  DO  NEXTCH; 

BLDNUMERIC (LOCALACC); 

NUMTOSTRC LOCALACC , WORKS TR ) ; 

MULT (MULPY , WORKS TR , WORKS TR ) ; 

ADD  ( WORKS  TR,  NUMSTRING,  NUMSTRING) 

END 

END;  (*  ADDAC  *) 

BEGIN 

BLWUJMERIC(YRACC); 

IF  YRACC  >  1900  THEN  YRACC  :«  YRACC  -  1900; 

LOCALACC  YRACC  DIV  4; 

YRACC  YRACC*365  +  LOCALACC; 

NUMTOSTRC  YRACC,  NUMSTRING  )  ; 

MULT  ( 86  40  0 ,  NUMS  TR ING ,  NUMS  TRING  )  ; 

ADDACC( 86400); 

ADDACC(3600); 

ADDACC(60) ; 

ADDACC(l); 

NUMPTR  11; 

NUMSTRING [NUMPTR  +  2]  'O'; 

NUMSTRING  [NUMPTR  ♦  1]  'O'; 

NUMSTRING [NUMPTR]  'O'; 

IF  CH  -  ','  THEN 
NEXTCH ; 

WHILE  (CHARTP[CH]  IN  [DIGIT ] )  DO  BEGIN 
NUMSTRING  [NUMPTR]  NUMSTRING  [NUMPTR  +  1]; 

NUMSTRING  [NUMPTR  +  1]  NUMSTRING  [NUMPTR  +  2]; 

NUMSTRING  [NUMPTR  +  2]  CH; 

NEXTCH  END; 

NUMPTR  :«  NUMPTR  +  4;  NUMSTRING  [NUMPTR  -  1]  'D' 

END  ;  (*  NEXTIME  *) 

PROCEDURE  GETNUMBER; 
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BEG  IK 

NUMPTR  :■  1; 
CASE  NUMTYPE  OF 
NUMALPHA  : 


BEG  IK 

WHILE  CHAR TP [CH 3  IK  [LETTER, DIGIT]  DO 
BEG  IK 

IF  CHAR TP [CB]  IN  [LETTER]  THEN 
BEGIN 

NUMSTRING  [NUMPTR]  :-CR; NUMPTR  : -NUMPTR  +  1; 

NEXTCH  END; 

IF  CHAR TP [CH]  IN  [DIGIT]  THEN  GET INTEGER  END; 

IF  (NUMPTR  -  3)  THEN 
BEGIN 

NUMSTRINGl NUMPTR]  :«  '  '; NUMPTR  NUMPTR  +  1; 

END 

END;  (*  ALPHANUMERIC  CASE  *) 

NUMINT  : 

BEGIN 

IF  CHAR TP [CH]  IN  [SIGN]  THEN  BEGIN 
NUMSTRINGl  NUMPTR]  :«  CH;  NUMPTR  NUMPTR  +  1; 

NEXTCH  END; 

GET  INTEGER 

END;  (*  NUMERIC  INTEGER  CASE  *) 

NUMREAL  : 

BEGIN 

IF  CHAR TP [CH]  IN  [SIGN]  THEN 
BEGIN 

NUMSTRINGt NUMPTR]  CH;  NUMPTR  NUMPTR  +  1;  NEXTCH  END; 
GET INTEGER; 

IF  (CH  -  THEN  BEGIN 

NUMSTRINGt NUMPTR]  NUMPTR  NUMPTR  +  1; 

NEXTCH; 

GET INTEGER 
END 

ELSE  BEGIN 

NUMSTRING[ NUMPTR]  NUMPTR  :«  NUMPTR  +  1  END 

END;  (*  END  OF  NUMREAL  STATEMENT  *) 

NUMTIME  : 

NEXTIME 

END  (*  END  OF  CASE  *) 

END;  (*  GETNUMBER  *) 

PROCEDURE  NEXTRELATION ; 

TYPE 

RELSPECIFIED  -  (RELSPEC,RELNOTSPEC); 

VAR 

RELTYPE  :  RELSPECIFIED; 

BEGIN 

IF  CHARTP [CH]  IN  [RELATION]  THEN 

RELTYPE  RELSPEC  ELSE  RELTYPE  RELNOTSPEC; 

CASE  RELTYPE  OF 
RELNOTSPEC  : 

BEGIN 

RELSTRING [ 1 ]  :« 

RELSPEC  ; 

BEGIN 

IF  '  ''  THEN 
RELSTRING [ 1 ] 

ELSE 

BEGIN  RELNOT  :- 
END; 

IF  CHARTP [CH]  IN  [RELATION]  THEN 
CASE  CH  OF 
: 


'E';  RELSTRING! 2]  'Q';  RELNOT  FALSE  END; 

BEGIN  RELNOT  TRUE; 

'N';  RELSTRING [2]  'E' ;  NEXTCH  END 

FALSE;  REL STRING! 1 ]  'E' ;  RELSTRING [2]  'Q' 


BEGIN 

IF  RELNOT-FALSE  THEN 
BEGIN  RELSTRING[  1]  :■ 
ELSE 

BEGIN  RELSTRING[1]  :* 
'>'  : 

BEGIN 

IF  RELNOT-FALSE  THEN 
BEGIN  RELSTRING [  1]  :* 
ELSE 

BEGIN  RELSTRING!  1]  :■ 

; 

BEGIN  RELSTRING!  1]  :« 


V\  RELSTRING!  2]  : 
G';  RELSTRING! 2]  : 

G';  RELSTRING! 2]  : 
L";  RELSTRING! 2]  : 
E';  RELSTRING [2]  : 


T' ;  NEXTCH  END 
E" ;  NEXTCH  END  END; 

T' ;  NEXTCH  END 
E';  NEXTCH  END  END; 
Q';  NEXTCH  END; 
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END;  (*  CASE  <  >  -  *) 

IF  CH  -  THEN  BEGIN  RELSTRING[2]  :-  'E';  NEXTCH  END 
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END  (*  RELSPEC  CASE  *) 

END  (*  R EL TYPE  CASE  *) 

END;  (*  NEXTRELAT ION  *) 

PROCEDURE  EXPRESSION; 

TYPE 

EXP  RANGE  -  ( EXITYFE , HITYPE ) ; 

VAR 

I  :  INTEGER; 

EXPTYPE  :  EXPRANGE; 

BEGIN 

WHILE  NOT  (CHARTPtCH]  IN  [LETTER, SIGN, DIGIT, RELATION] ) 

DO  NEXTCH ; 

IF  CHAR TP [CH]  IN  [ SIGN, DIGIT, RELATION ]  THEN 
EXPTYPE  :*  HITYPE  ELSE  EXPTYPE  : *  EX I TYPE ; 

CASE  EXPTYPE  OF 
EXITYPE  :  ; 

HITYPE  : 

BEGIN 

NEXTRELAT ION; 

WRITE (OUTPUT,"  '); 

WRITE (OUTPUT,"  EXIT  LOOP  IF  ("); 

GETNUMBER; 

IF  CH  -  "/"  THEN 
BEGIN 

WRITE ( OUTPUT ,"('); 

WRITE  (OUTPUT,  PARAKS THING)  ; 

WRITE(OUTPUT,".GE."); 

FOR  I  :  *  1  TO  (NUMPTR-1)  DO  WRITE ( OUTPUT,  NUMSTRING  [  1 3  ) ; 

CASE  NUMTYPE  OF 

NUMINT ,  NUMREAL ,  NUKDBL  : 

WRITE(OUTPUT, ") .AND. ( '); 

NUMTIME  : 

BEGIN  WRITE ( OUTPUT,  ")  .AND.  ")  ;  WRITELN( OUTPUT )  ; 

WRITE(OUTPUT»"  ♦(")  END 

END; 

WR IT E ( OUTPU T , PARAMS TR LNG ) ; 

WRITE (OUTPUT, " .LE. " ) ; 

NEXTCH; 

GETNUMB  ER ; 

FOR  I  :■  1  TO  ( NUMPTR- 1 )  DO  WR ITE( OUTPUT, NUMSTRING [ 1 3 ) ; 
WRITE (OUTPUT, "))"); 

WRITELN(  OUTPUT); 

EXPRESSION 

END 

ELSE 

BEGIN 

WRITE  ( PARAMS  TR  ING  )  ; 

WRITE (OUTPUT, " . " , REL STRING, ' . ") ; 

IF  NUMTYPE  -  NUMALPHA  THEN 
BEGIN 

WRITE(OUTPUT, "”SLN" ) ; 

FOR  I  :-l  TO  NUMPTR  -  1  DO  WRITE(OUTPUT,  NUMSTRING  [  I )) ; 
WRITE(0UTPUT,"""); 

END 

ELSE 

FOR  I  1  TO  NUMPTR  -  1  DO  WRITE  (OUTPUT,  NUMSTRING  [  I  ]) ; 
WRITE  (OUTPUT,  ")')’, 

WRITELN( OUTPUT  ) ; 

EXPRESSION 
END  (*  IF  /  *) 

END  (*  STATEMENT  OF  CASE  *) 

END  (*  CASE  *) 

END;  <*  EXPRESSION  *) 

PROCEDURE  TERM; 

VAR 

J,I  :  INTEGER; 

BEGIN 
I  :-l; 

REPEAT 

IF  I  <  7  THEN  BEGIN  PARAMS TR ING [ 1 3  :-CH;  I  1+1  END; 
NEXTCH; 

UNTIL  NOT(CHARTP[CH]  IN  [LETTER]); 

FOR  J  I  TO  6  DO  PARAMS THING [ J ]  "  "; 

KWTYPE  INVALID; 

FOR  I  1  TO  MAXRESVWDS  DO 

IF  KWSETlI]  -  PARAMS THING  THEN  BEGIN  HWTYPE  RWARG [ I ] ; 
NUMTYPE  :«  KWNUMTP[I]; 

BWARG[I]  USED  END; 

CASE  RWTYPE  OF 
INVALID  : 
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BEGIN 

WRITECDIAG,'  KEYWORD 
VRITELN(DIAG) 

END; 

USED  : 

BEGIN 

VRITE(DLAG,"  keyword 
VRITELN(DIAG); 

END; 

PAU  :  ; 

CHANNEL  :  ; 

VALID  : 

BEGIN 

VRITE(OUTPUT," 

WRIT  ELN(  OUTPUT); 
EXPRESSION; 

WRITE (OUTPUT," 

WR  IT  EL  N(  OUTPUT) ; 
VRITE(OUTPUT," 

WRIT  ELN(  OUTPUT); 
WRITE(OUTFUT," 

WRIT ELN( OUTPUT) 

END; 

END 


"  ,  PARAMSTRING,  "  IS  INVALID"); 


" , PARAHSTRLNG, "  USED"); 


LOOP ( 1 ) " ) ; 

QPLAG  -  .FALSE.'); 

END  LOOP"); 

EXIT  LOOP  IF  ( .NOT.QFLAG) ") ; 


END;  (*  TERM  *) 

PROCEDURE  CHSET ; 

VAR  KK,I  ;  INTEGER; 

BEGIN 

IF  RWSET [  17  ]  *  PARAMSTRING  THEN 

BEGIN 

KK  :-l; 


REPEAT 

NEXTCH; 

WHILE  CHARTP[CH]  IN  [DIGIT]  DO 
BEGIN 

GETNUMEER; 

WRITE (OUTPUT, "  ICHN( ",KK, ")*") ; 

FOR  I  :-l  TO  (NUMPTR-1)  DO  WRITE ( OUTPUT,  NUMSTRING [  I )) ; 
WRITELN; 

KK  :«  KK+1; 

END 

UNTIL  CHAR TP [CH]  IN  [LETTER] 

END 

ELSE 


END; 

(* 

CHSET  *) 

PROCEDURE 

SETEWSET; 

BEGIN 

RWSETl 1)  : 

-  "RANGE  "; 

RWSETI2]  'EXPLOS'; 

RWSET [3]  : 

-  "TYPE  "; 

RWSET[4]  'ETIME 

RWSET[5]  : 

■  EN  UM  ; 

RWSET[6]  :«  'STIME 

RWSETI7]  'ELAT 

RWSETl 8]  : 

-  "ELON  '; 

RWSET[9 ]  'EDEP 

RWSET[10]  'WDEPE  ' 

RWSET [ 11 ] 

:«  "SIZE  " 

;  RWSETl 12]  'INUM 

9 

RWSETt 13] 

"HAT  ' 

;  RWSETl 14]  'ILON 

1 

RWSET] 15] 

:*  "IDEP  " 

;  RWSETl 16]  !■  'WDEPI 

* 

RWSET  [17] 

:*  "CHAN  " 

RWSET! 18] 

:  *  "SHOTLN" 

;  RWSET [19]  'TAPENM 

9 

RWSET  [20] 

:«  "END 

END; 

PROCEDURE  SETKWARG ; 

BEGIN 

EWARG[1]  VALID;  RWARG [ 2]  :«  VALID;  RWARG[3]  :«  VALID; 

RWARG [4]  VALID;  RWARG [ 5]  :«  VALID;  RWARG 1 6 3  :«  VALID; 

RWARG [7  ]  VALID;  RWARG [  8]  VALID;  RWARG [9]  VALID; 

RWARG [ 10]  VALID;  RWARG[11]  :»  VALID;  RWARG[12]  :«  VALID; 

RWARG[ 13]  VALID;  RWARG[14]  VALID;  KWARG[15]  VALID; 

RWARG [ 16 ]  VALID;  RWARG[17]  CHANNEL; 

RWARG [ 18]  VALID;  RWARG[19]  VALID; 

RWARG [ 20]  PAU; 

END; 

PROCEDURE  SETKWNUM; 

BEGIN 

RWNUMTP [  1  ]  NUMREAL;  RWNUMTP[2]  NUMINT; 

RWNUMTP [3]  NUMINT;  KWNUKTP[4]  NUMTIME; 

RWNUMTP [5]  NUMINT; 

RWNUMTP! 6]  NUMTIME;  EWNUMTP[7]  NUMREAL; 

RWNUMTP [8]  NUMREAL;  RWNUMTP [9]  NUMINT; 

RWNUMTP [  10]  NUMINT;  RWNUMTP [11]  NUMREAL; 

RWNUMTP[  12]  NUMINT;  RWNUMTP[13]  NUMREAL; 

RWNUMTP[14]  NUMREAL;  RWNUMTP[15]  NUMINT; 

RWNUMTP [  16 ]  NUMINT;  RWNUMTP[17]  NUMINT; 
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401 

EWNUKTP 1 1 8] 

KUMALFHA;  KWNU>CrP  [  19  3  : 

-  NUMINT; 

402 

KWNUMTP 1 20]  :* 

NUMINT; 

403 

END; 

404 

PROCEDURE  PROLOG; 

405 

BEGIN 

40b 

WRITE (OUTPUT,' 

loop(D'); 

407 

WRITELNC OUTPUT); 

408 

WEITECOUTPUT, ' 

QFLAG* . TRUE . ' ) ; 

409 

WRITELNC  OUTPUT) 

410 

END; 

411 

PROCEDURE  JOB; 

412 

BEGIN 

413 

PROLOG; 

414 

REPEAT 

415 

WHILE  HOT ( CHARTP [ CH ]  IN  l LETTEE ] )  DO  NEXTCB; 

416 

TERM; 

417 

CHSET; 

418 

UNTIL  RWTYPE  * 

PAU; 

419 

WRITECOUTFUT/ 

END  LOOP'); 

420 

WRITELNC  OUTPUT); 

421 

WEITECOUTPUT,' 

IF  C  QPLAG ) ' ) ; 

422 

WEITELNC  OUTPUT); 

423 

WEITECOUTPUT,' 

SELFLG* .TRUE. ') ; 

424 

WEITELNC  OUTPUT); 

425 

WEITECOUTPUT/ 

ELSE'); 

426 

WEITELNC  OUTPUT); 

427 

WEITECOUTPUT,' 

SELFLG*. FALSE. ' ) ; 

428 

WEITELNC  OUTPUT); 

429 

WEITECOUTPUT,' 

END  IF'); 

430 

WRITELNC  OUTPUT); 

431 

WEITECOUTPUT,' 

RETURN  ) ; 

432 

WRITELNC OUTPUT); 

433 

WRITE  (OUTPUT/ 

END'); 

434 

WRITELNC  OUTPUT); 

435 

END; 

436 

PROCEDURE  CHAR TYPES; 

437 

VAR  I  :  INTEGER; 

43  8 

BEGIN 

439 

FOR  I  :*  32  TO  9  5  DO  CHARTP [CHR( I ) ]  : 

«  ILLEGAL; 

440 

CHARTP [ 'A' ] 

*  LETTER  ; 

441 

CHARTP  l  'B'  ] 

«  LETTER  ;  CHARTP ['C'] 

-  LETTER  ; 

442 

CHARTP I'D'] 

•  LETTER  ;  CHARTP [ ] 

*  LETTER  ; 

443 

CHARTP l'F'1 

-  LETTER  ;  CHARTP /G'] 

-  LETTER  ; 

444 

CHARTP I'H'j 

-  LETTER  ;  CHARTP ['I'] 

-  LETTER  ; 

445 

CHARTP I'J'] 

-  LETTER  ;  CHARTP /K'  ] 

-  LETTER  ; 

446 

CHARTP l 'L' ] 

*  LETTER  ;  CHARTP  I'M'] 

*  LETTER  ; 

447 

CHARTP I'N'j 

-  LETTER  ;  CHARTP /O'] 

«  LETTER  ; 

448 

CHARTP l'P'1 

*  LETTER  ;  CHARTP /Q'l 

-  LETTER  ; 

449 

CHARTP ['R'] 

-  LETTER  ;  CHARTP ['S') 

-  LETTER  ; 

450 

CHARTP I'T'] 

-  LETTER  ;  CHARTP /U'] 

*  LETTER  ; 

451 

CHARTP I'V'J 

■  LETTER  ;  CHARTP /W'] 

-  LETTER  ; 

452 

CHARTP  ['X'] 

«  LETTER  ;  CHARTP /Y' ] 

-  LETTER  ; 

453 

CHARTP I'Z'J 

-  LETTER  ;  CHARTP/0'] 

-  DIGIT  ; 

454 

CHARTP l '1 '] 

■  DIGIT  ;  CHARTP[ '2']  DIGIT  ; 

455 

CHARTP L '3'] 

-  DIGIT  ;  CHARTP [ '4']  DIGIT  ; 

456 

CHARTP l '5') 

-  DIGIT  ;  CHARTP [ '6']  DIGIT  ; 

457 

CHARTP  1 '7'] 

-  DIGIT  ;  CHARTP['8']  DIGIT  ; 

458 

CHARTP  l  '9  '] 

■  DIGIT  ;  CHARTP ['+']  SIGN  ; 

459 

CHARTP l '-' J 

-  SIGN  ;  CHARTP [ '*' J 

«  SPECIAL; 

460 

CHARTP 1 ' / ' ] 

-  SPECIAL;  CHARTP [ ' ( ' J 

*  SPECIAL; 

461 

CHARTP l ' ) ' ) 

-  SPECIAL;  CHARTP t '$ ' J 

-  SPECIAL; 

462 

CHARTP 1 '“ ' ] 

-  RELATION;  CHARTP t '  '1 

SPECIAL 

463 

CHARTP l ', '] 

-  SPECIAL;  CHARTP [ '.')  : 

SPECIAL; 

464 

CHARTP  l  "  "  ] 

SPECIAL;  CHARTP [ 'l '] 

SPECIAL 

465 

CHARTP 1 ' ) ' ] 

SPECIAL;  CHARTP[':'J  : 

SPECIAL; 

466 

CHARTP l "]  :■ 

*  SPECIAL;  CHARTP [ ' ;  ' J  :■ 

■  SPECIAL; 

467 

CHARTP l'<') 

: -  RELATION;  CHARTP['>'] 

:«  RELATIO 

468 

CHARTP l " ] 

RELATION; 

469 

OEDINTl'O') 

-  0;  ORDINTl  '1']  :«  1;  ORDINT/2'] 

47  0 

ORDINTl'3') 

-  3; 

471 

ORDINTl '4'] 

-  4;  ORDINTl '5']  5;  ORDINTl '6'] 

47  2 

ORDINTl  '7  ']  : 

-  7;  ORDINTl '8']  8;  ORDINT['9'] 

47  3 

END; 

47  4 

PROCEDURE  HEADLD; 

47  5 

FORTRAN; 

47  6 

BEGIN 

477 

HEADLD; 

RESET(DIAG); 

47  8 

479 

WRITELNCDIAG, 

'  CPU  TIME  «  ' : 15 ,CLOCK:6) ; 

480 

CHARTYPES; 

481:  SETRWSET; 

482:  SETRWARG ;  335 

483:  SETRVHUM; 

484:  WHITE r  '); 

48!>:  NEWLINE; 

486:  NEXTCB; 

487:  JOB; 

488:  VRITELNCDLAG,'  CPU  TIME  -  ' :  15  ,CLOCK:6) 

489:  END. 


1:  SUBROUTINE  HEADED 

2:  INTEGER  INAKE1(3) , INAME2C3) ,  IB  UPC  27 ) 

3:  DATA  INAMEi /"RECSEL  , IHAME2/"SUB0UT  "/ 

4:  CALL  ASSIGN! 10, INAMEl , IERH) 

5:  CALL  ASSIGNC7 , INAME2.IERR) 

6 :  LOOP 

7:  BUFFER  INC  10 ,  IBUF,  S,  27  ,  ISTAT,  ILEN ) 

8:  CALL  STATUS! 10) 

9:  EXIT  LOOP  IF(ISTAT.GE.3) 

10:  BUTTER  OUTC7  ,  IBUF,  S, 27  ,  ISTAT,  HEN ) 

11:  CALL  STATUS! 7 ) 

12:  END  LOOP 

13:  RETURN 

14:  END 


1:*  FILENAME  HEAD;  HEADING  LINES  FOR  SELECTION  SUBROUTINE 
2:  SUBROUTINE  RECSEL! ICHN, SELFLG) 

3:  INTEGER  ICHN!  8) 

4 :  INTEGER  TYPE , ENUM , EDEP , VDEPE , S 12 E , EXPL 0  S ,  VDEP I , TAPENM 

5:  INTEGER*6  ST IKE 

6:  REAL  HAT,  ILON 

7:  COMMON  /KEYS /  TAPENM, INUM, ENUM, ST IME, SIZE, RANGE, ILAT, ILON, 

8:  +  ELAT, ELON, EXPLOS, VDEPI,WDEPE , IDEP , EDEP, TYPE, SHOTLN 

9:  LOGICAL  SELFLG , QFLAG 

10:  FOR  1-1,8 

11 :  ICHN! I)  -  9999 

12:  END  FOR 
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1:  $MS 
2:  $RW  3 
3 :  $M0  RE 

4:  $PR  MACRO  M<S LARCH  TO  GENERATE  SELECTION  CRITERIA  A  SEARCH  CATALOG 
5:  $AS  10-T1 

6:  $PR  ARE  INPUT  PARAMETERS  IK  FILE  PAS C IK?  (1) 

7:  $PR  OR  IS  INPUT  FROM  THE  TERMINAL?  (2) 

8:  $SR.  IN  #N 
9:  IF  (# N-2)  $JU  ITER 
10:  $AS  20-PAS CIN 
11:  $JU  ICON 
12:  ITER  AS  20-*0 
13:  ICON  $$XS ELECT 
14:  $FR  5  6 
15:  $F0.P  RECSEL 
16:  $PR  SUBROUTINE  COMPILED 
17:  FR  6 
18:  $C0  LO  S2 
19:  $JS  SRCHVU 

20:  SPR  MAIN  AND  SUB  VULCANIZED 

21 :  $PR  WANT  TO  CONTINUE  AND  SEARCH  CATALOG?  ENTER  Y  OR  TO  STOP  ENTER  N 

22:  SSR.IT  #ANS 

23:  IF  (#ANS-"N")  $JU  I  END 

24:  PR  RUN  FROM  TERMINAL  OR  CONTROL  POINT  (T  OR  C)7 

25:  SR. IT  #ANS 

26:  IF  (#ANS-"T" )  $JD  ITERM 

27:  U  JSRCB 

28:  PR  JOB  JSRCH  INSERTED.  LIST  S2  FOR  RECSEL,  LISTOUT  FOR  JOB 

29:  PR  AND  SCOUT  FOR  DATA  SELECTED 

30:  $ME 

31:  ITERM 

32:  AS  6«*0 

33:  AS  3 0- REV CAT. B 

34:  AS  40-T2 

35:  AS  50-SRCHHD 

36:  PR  RUNNING  CATALOG  SEARCH  NW 
.  $$XSEARCH 

38:  I  END  PR  M<SEARCB  ALL  PAU :  LIST  S2  FOR  RECSEL,  T2  FOR  SELECTION  CRITERIA 
39:  $ME 
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*  PROGRAM  RE TREY 4  TO  RETRIEVE  ARCHIVED  EVENTS  AS  SPECIFIED  BY  A 

*  PARTICIPANT'S  REQUEST.  USES  AS  INPUT  THE  OUTPUT  FROM  XS EAR CB ( SEARCH :  3) 

*  (2  FILES,  ONE  WITH  RECORDS  TO  SELECT,  THE  OTHER  WITH  EVENT  HEADERS) 

*  AND  A  TAPE.  OUTPUTS  ARE  (1)  A  DATA  FILE  OF  SELECTED  EVENTS  AND 

*  (2)  A  TAPE  HEADER  FILE  IN  WHICH  THE  NUMBER  OF  EVENTS  REFLECTS 

*  ALSO  REMOVES  KEAN  FROM  UW  DATA 

* 

*  USE  MACRO  M<RETREV  COMPILE  WITH  J. RET 

* 

*  SAUF77.I  RETREV4 

*  VU.R  IRETREV4  PA-3 

*  LIB  1500MGG*MRSLIB  *SAUL77  *LIBERY 

*  AS  88-T1 

* 

*  LAST  MODIFIED  3/08/83  SLL 

* 

IHTEGER  THBUF(256) ,KBUF(256) ,IBU?(8192) .TAPE, SELIN, OUTF, HDOUT 
INTEGER  APILES(4)  , ENUMS , FNUM, LB UF( 256 )  ,FHLFN 
IHTEGER  ENUMMX ,  ENUMMN ,  I3LAY  ( 7  )  ,  TRAY  1(7) 

IHTEGER*6  TDST.TDET 

DIMENSION  DNAME ( 9 ) ,EXC0DE(4) ,SHTLN( 10) ,XF(4096) 

EQUIVALENCE  (ZF.IBUF) 
eOMMON/ITCM/  TRAY.CSEC, JULD 

DATA  TAPE/4/, SELIN/ 15/, HDOUT/11/ .OUTF/20/ .FHLFN/50/ 

OPEN  TAPE 
OPEN  FHLFN 
ICNT-0 
ISTOP-0 

READ(  SELIN,  100,  EN>*999  )  JIAP ,  INUMS , ENUMS , FNUM 
100  FORMAT(4I6) 

*  Save  tape  number  and  IID  number  just  read 

LTAP-JTAP 
LINU>M=  INUMS 

*  Find  HIG  tape  header  file  -  ahould  be  first  file  of  each  Archive 

DO 

.  BUFFER  IN  (TAPE, IBUF.B, 4096, IS,  H) 

.  CALL  STATUS(TAPE) 

UNTIL  ( IL.EQ.224) 

DECODE(9  ,4000, IBUF)  ITAP 
4000  FORMAT(3X, 16) 

IFClTAP. NE. JTAP)  STOP  TAPENM 

DECODE  ( 17  4 , 6  002 ,  IBUF  (9  5  )  )  IID , DNAME , EXCODE , NFILES , TDST, TDET , SHTLN 
6002  FORMAT ( 14 , 1 2A6 , A2 , 16, 114, IX, 114, IX, 10A6 ) 

WRITE(3,2001)  ITAP 

2001  FORMATC/1X, 'ROSE  ARCHIVE  TAPE  NO. ' ,T40, 16) 

WRITE(3 ,2  027  ) 

2027  FORMAT ( IX ,  '**+**  TAPE  HEADER  FILE  CONTENTS  «**«*') 

WRITE(3,2028)  IID, DNAME 

2028  FORMAT (IX,' IN STR.  #',T20,I4,'  DESIGNER' ,T40, 9 A6) 

WRITE(3,2029)  EXCODE, NFILES 

2029  F0RMAT(1X, 'EXPERIMENT:', T20,3A6,A2,'  #  OF  EVENTS:', 

+T60.I6) 

*  Save  ROSE  Archive  tape  header 

DO 

.  BUFFER  IN  (TAPE, THBUF.B, 236  ,  IS,  IL) 

.  CALL  STATUS (TAPE) 

UNTIL  (IL.EQ.236) 

FOR  11-1,256 
.  KBUF(II)-THBUF(II) 

END  FOR 

*  Get  data  from  tape 

1  LOOP  If or  1  event 

.  DO 

.  .  BUFFER  IN  (TAPE, IBUF.B, 4096, IS, H) 

.  .  CALL  STATUS (TAPE) 

.  .  IF(IS.GT.3) 

.  .  .  WRITE(3,155) 

155  ...  FORMAT ( '  EOF  OH  INPUT') 

.  .  .  GO  TO  999 

.  .  END  IF 

.  UNTIL(IL.EQ.256) 

.  IF(IBUF(1).NE.  INUMS) 

.  .  WRITE(3,"('  INSTRUMENT  #  ON  TAPE:  ',15,'  DOES  NOT  MATCH', 

+  .  .  '  INSTRUMENT  #  OF  SEARCH:  ',15)")  IBUF ( 1 ), INUMS 

.  .  STOP  INUM 

.  END  IF 
.  IF ( ENUMS . NE . 0 ) 

*  Look  for  event  or  file  #  match 

.  .  EXIT  LOOP  IF (ENUMS. EQ.IBUF(3)) 

.  .  EXIT  LOOP  IF (FNUM. EQ. IBUF (41)) 
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.  END  I? 

•  IF  (  ENUMS .  EQ  *  0  ) 

.  .  EXIT  LOOP  IF  (FNUM*  EQ.  IBUF(41 )  ) 

.  END  IF 
END  LOOP 

*  Read  event  headers  from  search  file  (which  comes  from  Revcat) 

2  BUFFER  IN(PHLFN,LBUF,B,256,IS,IL) 

CALL  STATDS(FHLFN) 

IFC1S.GE.3) 

.  VRITE(3,2050)  ENUMS  ,  IFUMS 

2050  .  FORMAT ( *  Event  ',16,'  or  Rev  ',16,'  not  found  in  header  file', 

+.  /'  rewinding  header  file') 

•  ISTOP-ISTOP+1 

.  IF(IST0P.GE.5)  STOP  ERROR 
.  REWIND  50 

•  GOTO  2 
END  IF 

*  Match  event#  and  inst# 

IF(LBUF(3).NE. ENUMS)  GO  TO  2 
IF(LBUF(1) .  ne. tnums)  go  TO  2 
NOLBUF(39) 

ISK-41 

LLR-LBUF(7  2) 

*  Fill  in  words  62-70 

FOR  J-1,NC 
.  FOR  1-42,50 

.  .  LBUF(I+20*J)-IBUF(I+20*J ) 

•  END  FOR 
END  FOR 
IF(LLR.EQ.O) 

.  IF(ICNT.EQ.O) 

.  .  VRITE(3 ,”( 'Using  tape  headers  instead  of  those  from  REVCAT')”) 

.  END  IF 
.  FOR  J-1,NC 
.  .  FOR  I-ISK, 52 

.  .  .  LBUF(I+20*J )-IBUF(I+20*J ) 

.  .  END  FOR 

.  END  FOR 
.  LLR-IBUF(72) 

END  IF 
ICNT-ICNT+1 
LBUF(41 )-ICNT 
IF(ICNT.EQ.l) 

.  ENUMMN-ENUMS 
.  FOR  1-1,7 
.  .  TRAY ( I ) -LBUF ( 1+3 ) 

•  END  FOR 
END  IF 

BUFFER  OUT  (  OUTF ,  LBUF ,  B ,  2  56  ,  IS ,  EL ) 

CALL  STATUS (OUTF) 

IF(IS.GT.3) 

.  WRITE(3 , 107 ) 

107  •  FORMAT ( '  EOT  ON  OUTPUT') 

.  STOP  ERROR 
END  IF 

VRITE(3 ,110)  LBUF (3) ,LBUF (1) ,FNUM, ICNT 
110  FORMAT ( '  RETRIEVING  EVENT  #',I6,'  RCV  ',14, 

+'  OLD  F#  ',14,'  NEW  F#  ',14) 

K-LBUF(71) 

N-(LBUF(39))*K 

JCNT-0 


*  Loop  to  get  data 

LOOP 

BUFFER  IN  (TAPE, IBUF.B, 4096, IS, IL) 

CALL  STATUS (TAPE) 

LTH-4096 
IFCIS.GE.3) 

IF( JCNT.LT. N)  VRITE(10,"(' 

'  IN  HEADER', 316)")  ENUMS, 

IF(JCNT.CT.N)  WRITE(10,"(' 

'  IN  HEADER', 316)")  ENUMS, 

EXIT  LOOP 
END  IF 
JCNT-JCNT+1 

IF (I ID. GE. 400. AND. I ID. LE. 499 ) 

*  Convert  integer  to  real  thru  equiv  arrays  and  reoove  nean 
FOR  1-4096,1,-1 
.  XF(I)-IBUF(I) 

END  FOR 
IF(JCNT.EQ.K) 


RECORDS  BEAT)  LESS  THAN  SPECIFIED', 
N,  JCNT 

RECORDS  READ  MORE  THAN  SPECIFIED', 
N,  JCNT 
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•  •  •  LTb*LLR 

.  .  .  JCNT-0 

.  .  END  IF 

.  .  CALL  MEAN(XF.LTH)  139 

.  .  FOR  I-l.LTB 

.  .  .  IBUF(I)”XF(I) 

•  «  Em  D  FO  R 

.  .  IF (LTH.LT. 4096) 

.  .  .  L-LLR+1 

.  .  .  FOR  I-L.4096 

.  .  .  .  IBUF(I)“0 

.  .  .  END  FOR 

.  .  END  IF 

.  END  IF 

.  BUFFER  ODTCOUTF,  IBUF,  B,4096  ,  IS ,  IL) 

.  CALL  STATU S(OUTF) 

.  IF(IS.GT.3) 

.  .  WRITE(3,107 ) 

.  .  STOP  ERROR 

.  END  IF 
.  nTUMMX-ENUMS 
END  LOOP 
ENDFELE  OUTF 

READ (SELIN ,100, END-99 9)  JTAP, INUMS , ENUMS , FNUM 
IF ( JTAP . NE . LTAP )  GO  TO  888 
IF (INUMS.NE. LINUX)  GOTO  888 
C  IF(INUMS.NE.IID) 

C  IF(ICNT.EQ.l) 

C  WRITE(3,"('  I  ID  ON  TAPE-', 14,'  INUHS-' ,  14)"  )IID,  INUMS 

C  END  IF 

C  END  IF 

GO  TO  1 

*  Encode  ICNT  into  NFILES  in  header 
888  BACKSPACE  SELIN 
WRITE(3,166) 

166  FORMAT ( '  NORMAL  EXIT') 

999  VRITE(3,120)  ICNT 

120  FORMAT ( '  NUMBER  OF  FILES-', 16) 

FOR  1-1,7 

.  TRAYl(I)-LBUF(I+3) 

END  FOR 

WRITE(88,140)  ICNT 
140  FORMAT(I8) 

BACKSPACE  88 
READ(88,130)  AFILES 
130  F0RMAT(4R2) 

FOR  1-1,4 

.  KBUF(50+I)«AFILES(I) 

END  FOR 

BUFFER  OCT(HDOUT,KBUF,B,256,IS,IL) 

VRITE(10,2001)  LTAP 
WRITE(10,2027 ) 

WRITE(10,2028)  LINUM.DNAME 
VRITE(  10,2035)  EXCODE, ICNT 

2035  FORMAT ( '  EXPERIMENT:  ',T20,3A6,A2,'  #  OF  EVENTS  RETRIEVED:', 

+T70.I6) 

VRITE(10,U('  EVENT  #S :  ',16,'  -  ',16)")  ENUMMN , ENUMMX 
VRrrE(10,"('  START  TIME  OF  FIRST  EVENT:  ',714)")  TRAY 
WRITE (10,"('  START  TIME  OF  LAST  EVENT: ',714)")  TRAY1 
STOP 
END 

SUBROUTINE  MEAN(XF.NPT) 

DIMENSION  XF(1) 

XM-XF(l) 

DO  1  I-2.NPT 

1  .  XM-XM+XF ( I ) 

XM-XM/NPT 

DO  2  I-l.NPT 

2  .  XF(I)“XF(I)-XM 
RETURN 

END 
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1 :  $MS 

2:  $PR  Macro  "1512ROSE*M<RETREV" 

3:  $PR  Macro  to  retrieve  archived  ROSE  data, 

4:  PR  and  write  it  to  tape.  Last  modified  by  CM 

5:  PR 

6:  IP, ( .NOT. (C. SPA.A&O) )  $JC  IDRI 
7:  $PR  Enter  name  of  header  file.  "i.e.  TEH.@@" 

8:  $SR.  XT  *PIL 
9:  $AS  U-#FIL 

10:  $PR  Enter  name  of  data  file.  "i.e.  TED.@@" 

11:  $SR.  XT  #FIL 
12:  $AS  20-#FIL 
13:  PR  Tape-drive  12  is: 

14:  /PS  12 

15:  PR  Tape-drive  10  is: 

16:  /PS  10 

17:  PR  Tape-drive  9  is: 

18:  /PS  9 

19:  PR  Enter  drive  Ho.  to  resource. 

20:  $SR. IN  #NOM 
21:  $J0  I  COPY 

22:  IDRI  PR  Tape-drive  12  is: 

23:  /PS  12 

24:  PR  Tape-drive  10  is: 

25:  /PS  10 

26:  PR  Tape-drive  9  is: 

27:  /PS  9 

28"  PR  Enter  drive  no.  to  resource. 

29:  $SR.IN  *NOM 

30:  PR  Mount  archive  tape  on  drive  no.  #NTJM 
31:  I MOO NT  RS  4-ARCTAP  1600B  WA  :#NOM 
32:  ITEM  PR  Do  you  want  to  assign  file  names?  Yes  /  blank  card  for  not. 

33:  SR.  IT  #IYS 

34:  IF  (#IYS)  JO  IGEN 

35:  PR  Do  you  want  to  stop?  Yes  /  blank  card  for  not. 

36:  SR. IT  #IYS 
37:  IF  (#IYS )  JO  !END 
38:  JO  ! SKIP 
39:  IGEN  KW  4 

40:  PR  Enter  name  for  data  output  file:  "TED.@(?". 

41:  SR.  IT  *FIL 

42:  $GE  #FU.  G500  M17  0000  BF-7  W  PD  PR  P3 
43:  JE  2150  IASD 
44:  IASD  AS  20-#FLL 

45:  PR  Enter  name  of  header  file:  "TEH.@@". 

46:  SR. IT  fHED 

47:  GE  #HED  G-2  OW  PD  PR  P3 

48:  JE  2150  IASH 

49:  IASH  AS  11-#RED 

50:  PR  Enter  name  for  report  file:  "TER.@@". 

51:  SR. IT  *REP 

52:  GE  #REP  G-10  OW  PR  PD  P3 
53:  JE  2150  IASR 
54:  IASR  AS  10-#REP 

55:  PR  Enter  the  name  of  the  SCOOT  file:  "SCOOT.@@  . 

56:  SR.  IT  #SC0 
57:  AS  15-#SC0 
58:  AR  15 

59:  PR  Enter  the  name  of  the  search  head  file:  "SRCHD.ee 
60:  SR. IT  #SRC 
61:  AS  50-#SRC 

62:  ISKIP  PR  Retrieval  starting  frcrn  firBt  (or  this)  file?  Yes  /  blank 

63:  SR. IT  #YES 

64:  IF  (#YES)  JO  I EXCOT 

65:  PR  Do  you  want  to  retrieve  manually?  Yes  (get  out  of  the  macro)/  blank 
66:  IF  (#YES)  JO  1MANOA 
67:  $$XTAP0S 

68:  I  EXCOT  $151 2R0SE*XRETREV4 
69:  IMAC  MA.E  #FIL 
70:  JE.P  37  IMAG 

71:  PR  More  to  retrieve  from  this  tape?  Yes  /  blank  card  for  not. 

7  2:  SR.  IT  #YES 

73:  IF, (#YES)  $J0  ITEM 

74:  PR  More  to  retrieve  from  another  tape?  Yes  /  blank  card  for  not. 

7  5:  SR. IT  *YES 

76:  IF, (#YES)  $J0  IMORE 

77:  JO  1FREE 

7  8:  IMORE  RW  4 

79:  PR  Mount  next  tape. 

80:  JO  ITEM 


81:  IFREE  FR  4 
82:  RW  11 
83:  RW  20 

84:  AS  12-T1  141 

85:  VI  12 

86:  CO  #REP  12 

87:  PR  Dismount  archive  tape. 

88:  PR 

89:  PR  Copy  disc  files  of  retrieved  data  to  tape?  Yes  /  blank  card  for  not. 

90:  SR. IT  #YES 

91:  IF, (#YES)  JD  1C0PY 

92:  JD  !END 

93:  ICOPY  PR  Enter  density  800  or  1600. 

94:  SR.  IK  #DEN 

95:  PR  Load  tape  for  retrieved  data  on  drive  no.  #NDM 
96:  PR 

97:  SR.N  #N0M-1 
9  8:  IF,  (#DEN“800)  JD  IEIGHT 
99:  RS  4* TRANSMIT  2C  1600B  WR  WA  :#NDM 
100:  JD  IVRIT 

101:  IEIGHT  RS  4-TRANSMIT  2C  800B  WR  WA  :#NUM 

102:  IWRIT  PR  Skip  data  set?  Yes  /  blank  card  for  not. 

103:  SR.  IT  #YES 
104:  IF  (*YES)  JD  IXSK 
105:  JD  IWR0T 
106:  IXSK  XSKIP 
107:  IWROT  $$XWRITP 

108:  PR  Data  for  data  set  #N0M  written  to  transmittal  tape. 

109:  SR.N  #NOM-#NOM+l 

110:  PR  More  data  in  thia  file?  Yea  /  blank  card  for  not. 

Ill:  SR. IT  #YES 

112:  IF  (#YES )  JD  IWRIT 

113:  PR  Write  data  from  another  file?  Yea  /  blank  card  for  not. 

114:  SR. IT  #YES 
115:  SR.N  #N0H-1 
116:  IF, (#YES)  $JD  IEDF 
117:  JD  ICHK 

118:  IEDF  PR  Enter  data  file  name. 

119:  SR.  IT  #FIL 
120:  AS  20-#FIL 

121:  PR  Enter  header  file  name. 

122:  SR.  IT  *FIL 
123:  AS  11-#FIL 
124:  JD  IWRIT 

125:  ICHK  PR  Now  do  check  read. 

126:  RW  4 
127:  AS  10-T3 
128:  XDISTAP 

129:  PR  Liat  T3  for  contents  of  tape  header. 

130:  FR  4 

131:  PR  Retrieval  Pau  -  Dismount  tape,  log  and  send. 

132:  PR  Eliminate  data  out  area. 

133:  IEND  PR  Next:  To  join  data  and  head  file,  and  demultiplex  data  use 
134:  PR  1512REF*JCOM.TEX,  JCOM.VBO,  JCOM.UW  or  JCOM.ARC.  (must  be  edited). 

135:  PR  A  L  L  P  A  D  D  .  .  .  D,  Se  acabo  estol 

136:  ALL 
137:  $ME 

138:  I MAG  FATAL  MAG  TAPE  ERROR 
139:  $ME 

140:  IMANDA  PR  Next:  advance  files  (AF  4  num. -files) 

141:  PR  print  JS  M<RETREV  tEXCDT  for  going  back  to  the  macro. 

142:  $ME 


142 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

7 

79 

8 


NAME  RARBIG 

C  PROGRAM  TO  CONVERT  ROSE  ARCHIVED  DATA  TO  HIG  DEMUX  DATA 
C  USE  DATA  FILE  OUTPUT  OF  ARCHIVE  AS  INPUT  FILE;  OR  LOAD  DATA  FROM 
C  THE  ARCHIVE  TAPE  AND  USE  TEAT.  WHEN  YOU  LOAD  FROM  TAPE,  BE  SURE  TO 
C  ADVANCE  ONE  FILE  BEFORE  YOU  COPY  DATA  TO  DISC  OR  IN  JOB STREAM. 

C 

C  LAST  UPDATED  5/13/83  _ 

C  AS  20-R0SE  FORMATTED  INPUT  DATA  FILE 

C  AS  40-CORFILE 

C  AS  10-Tl  (TEMP  FILE  FOR  HEADERS) 

c  AS  61-IMUTFUT  DEMUX  DATA  FILES  (1  PER  CHANNEL) 

INTEGER  MBUF(4032) , IRECNO( 500 ,24) , INEXT(24) 

INTEGER *1  ICRAY(162) ,DCBUF(162) 

INTEGER  IBUF(4096) ,DBUF(54) ,CATBUF(112) ,TRBUF(224) 

INTEGER  VDSLFT ,  CORFIL ,  HDFIL ,  ENUMMN ,  ENTJMMX 
INTEGER  ENUM,  EXPL , VDEPI ,  WDEPE ,  EDEP ,  TYPE ,  HERR,  ELOER 
INTEGER  BUB ,  SAMP ,  FNUM,  COMBUF  (  24)  ,  CCODE ,  CRA 
REAL  ELAT,  HON 

INTEGER *6  CSEC, STATS, TDST,DST, SBT 
DIMENSION  DNAME (9 ) , EXCODE (4) ,A(4) 

LOGICAL  HDRSW 

INTEGER  FHDR( 260) , CORE UF( 140) , TRAY (7 ) ,HDREC(17 ) 

COMMON  / ITCH/TRAY , CSEC , JULD 

EQUIVALENCE  (IBUF( 1 ) , ICRAY( 1 ) ) , (DBUF, DCBUF) 

DATA  INTTLE/20/  .CORFIL/ 40/  , HDFIL/ 10/ 

DATA  HDRSW/. TRUE./ 

BUFFER  IN(20,IBUF,B,4096  ,ISTAT,  HEN) 

CALL  STATU S( 20) 

JUMP-0 

J-l 

FOR  1-1,162 
.  K-M0D(I,3) 

.  IF  (K.NE.l) 

.  .  DCBUF(J)-ICRAY(I) 

.  .  J-J+l 

.  END  IF 
END  FOR 

C  DECODE  NUMBER  OF  FILES 

DECODE (9 , " ( IX , BN, 18 ) ' " , DBUF ( 34 ) )  IFILES 
DECODE (4," (BN, I4)",DBUF)IID 
DECODE (55 ,8005 ,DBUF( 2) )  DNAME 

8005  FORMAT ( IX, 9 A6 ) 

DECODE (20, 8006, DBUF (21))  EXCODE 

8006  FORMAT ( 3 A6 , A2) 

DECODE (12,8010, DBUF( 27 ) ) ISYR, ISMO , ISDA, ISHR, ISMIN 
8010  F0RMAT(2X, 512) 

DE  CO DE  ( 1 0 , 8 0  2  0 ,  DBUF  (  3 1 )  )  I FYR ,  IFMO ,  IFDA ,  IFHR ,  IFM  IN 

8020  FORMAT  (512) 

WRITE(3, 8040) IID, IFILES 

8040  FORMAT (IX," INSTRUMENT  ID  ",I4,/,"  #  FILES  ”,I4) 

WRITE (3, 8045)  DNAME 

8045  FORMAT (IX, 'DESIGNER  NAME  &  ADDRESS:  ",9A6) 

WRITE(3 ,8046 )  EXCODE 

8046  FORMAT ( IX , 3 A6 ,  A2 , "  EXPERIMENT") 

WRITE ( 3 , 8050)  ISYR ,  ISMC ,  ISDA ,  ISHR,  ISMIN 

8050  F0RMAT( IX, "START  TIME  ",5(1X,I2)) 

WRITE (3,8060) I FYR , IFMO , IFDA , IFHR , IFM IN 
8060  FORMAT (IX, "END  TIME  *,5(1X,I2)) 

FOR  1-1,140 
.  CORBUF(I)-"  " 

END  FOR 
JCNT-1 
LOOP 
.  DO 

1  .  .  BUFFER  IN(INFILE,FHDR, B, 260, IFSTAT, IFLEN) 

.  .  CALL  STATU S( INFILE) 

.  .  EXIT  LOOP  IF ( IFSTAT. GT. 3) 

.  UNTIL  (IFLEN. EQ. 256) 

.  CALL  CNVNEG ( FHDR , 256 ) 

.  IRN-FHDR(l) 

.  ISN-FHDR(3) 

.  KTYP-FHDR(2) 

.  FOR  J-l  ,7 

.  .  TRAY(J)-FHDR(J+27) 

.  END  FOR 
.  CALL  ITMCNT 
.  SBT- CSEC 
.  SD-FHDR( 26 ) / 1000. 

.  RD-FHDR(19)/1000. 

.  SIZE-(10.**(PHDR(36)/1000.))/1000. 
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.  RANG E-FL OAT (FHDR( 11 ) )*1000.+FLOAT(FHDR( 12) )+FLOAT(FHDR( 13) ) /1000 . 
.  IF(RANGE.LT. 0.0)  CALL  RANGER ( ILAT,  ELON, ELAT, ELON, RANGE) 

.  A(1)-FLOAT(FHDR(16))/1000. 

.  A(2)-FLOAT(FHDR( 18) )/1000. 

.  A(3)-FLOAT(FHDR(22))/1000. 

.  A(4)-FL0AT(FHDR( 24) )/1000. 

.  ILAT  *ISIGN( 1 ,FHDR( 15) )*(ABS(FLOAT(FHDR( 15) ) )+ABS(A(l ) ) ) 

.  HON  -ISIGN(  1  ,FHDR(  17  )  )*(ABS( FLOAT (FRDR(  17  )  )  )+ABS(A(  2)  )  ) 

.  ELAT  -ISIGN( 1 ,FHDR( 21 ) )* (ABS( FLOAT (FRDR( 21 ) ) )+ABS(A(3) ) ) 

.  ELON  -ISIGN( 1 ,FHDR( 23 ) )*(ABS (FLOAT (FHDR( 23 ) ) )+ABS(A(4) ) ) 

.  SAMP-FHDRC38) 

C  MAKE  CORFILE 

.  ENCODE (60 f  8080  ,  CORBUF ) IRN ,  IS N, TRAY ( 1 )  ,  JULD, 

+  .  ( TRAY ( J ) , J“4 , 7 ) 

8080  .  FORMAT(2I6,"01,,,I4,I3,3I2,I3,"01,,,28X) 

.  ENCODE (60, 8090 , CORBUF(21 ) )SD, SIZE, RD, RANGE 
8090  .  FORMAT (10X,2F10.4,10X,2F10.4) 

.  ENCODE ( 1 21 , 81 00 , CORBUF (7 4 ) ) ELAT, ELON ,  ILAT , ILON 
8100  .  FORMAT (1X,4(F10.4,20X)) 

.  BUFFER  OUT  (CORFU,  CO  RBUF,B,  140 , ICSTAT, ICLEN) 

.  CALL  STATU  S ( CORF IL ) 

.  IF  (HDRSW) 

.  .  LD^FHDR(39) 

.  .  FOR  I-1,LIM 

.  .  .  LFN-60+I 

.  .  .  OPEN  LFN 

.  .  .  CALL  BUFOUT(LFN,MBUF ,112,  IEOF ) 

.  .  .  CALL  BUFOUT(LFN,MBUF, 112, IEOF) 

.  .  .  CALL  BUFOUT(LFN,MBUF, 112, IEOF) 

.  .  .  ENDFILE  LFN 

.  .  .  INEXT(I)«4 

.  .  END  FOR 

.  .  IRNUM-0 

.  .  HDRSW-. FALSE. 

.  END  IF 

.  FOR  J*1 ,7 

.  .  TRAY(j)-FHDR(J+3) 

.  END  FOR 
.  CALL  ITMCNT 
.  DST-CSEC 

C  ENCODE  INFO  FROM  ROSE  FORMAT  FILE  HEADER  INTO  HIG  DEMUX  FILE  HEADER 
.  IF(INUM. GE. 200 .AND. INUM. LE. 299 ) 

.  .  SAMP* ( SAMP/ 100) +1 

.  END  IF 

.  ENCODE ( 51  , 807  0 , HDREC ) INUM, ENUM, SBT, DST , SAMP 
8070  .  FORMAT ( 2 16 , 2X , 2 II 6 , 13 , 2X ) 

.  BUFFER  OUTCHDFIL, HDREC, B, 17, MSTAT,MLEN) 

.  CALL  STATU S(HDFIL) 

C  NOW  TO  COPY  EACH  COMPONENT 
C 

.  IRNUM-IRNUM+1 
.  FOR  I-l.LIM 
.  .  IBASE-60+20*(I-l) 

.  .  IF( IBASE. GT. 240) 

.  .  .  IBASE- 240 

.  .  END  IF 

.  .  WDSLFT*(FHDR(IBASE+11 )-l)*4096+FHDR(lBASE+12) 

.  .  IF(FHDR( IBASE+11 ) *EQ. 0) 

.  .  .  VDSLFT-FHDR(71)*4096 

.  .  END  IF 

.  .  MAXBUP*MAXO(MAXBUF, VDSLFT ) 

.  .  LFN- 60+ I 

.  .  IRECNO( IRNUM, I)*INEXT(I) 

.  .  INWDS-0 

.  .  IPTR-1 

.  .  LOOP 

.  .  .  FOR  J-1,4032 

.  .  .  .  IF  (IPTR.GT. INWDS) 

.  INWDS*  KIN 0  (  40  9  6 , VDSLFT ) 

.  EXIT  FOR  IF(INWDS.EQ.O) 

. BUFFER  IN( INFILE,  EBUF,B,  INWDS,  ISTAT,  HEN) 

.  CALL  STATUS (INFILE) 

. CALL  CNVNEG(IBUF,  INWDS) 

.  VDSLFT-WDSLFT- INWDS 

•  «  .  »  .  LPT  R—  1 

.  .  .  .  BSD  IF 

....  MBUF(J)-IBUF(IPTR) 

.  .  .  .  IPTR-IPTR+1 

.  .  .  END  FOR 

.  .  .  J-J-l 
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.  .  .  CALL  BUFOUT(LFN,MBUF,J,IEOF) 

.  .  .  EXIT  LOOP  IF  (INWDS.EQ.O) 

.  .  END  LOOP 

.  .  ENDFILE  LFN 

.  .  CALL  DSTAT ( LFN , STATS , INEXT ( I ) ) 

.  END  FOR 
END  LOOP 
ENDFILE  HDFIL 
IRNUM-0 
REWIND  HDFIL 
LOOP 

.  BUFFER  IN(HDFIL»HDREC,B,17  , ISTAT,  HEN) 

.  CALL  STATU S( HDFIL) 

.  EXIT  LOOP  IF(ISTAT.GE.3) 

.  IRNUW- IRNUM+ 1 
.  FOR  1-1 ,LIM 
.  .  LFN-60+I 

.  .  HDREC(18)-IRECNO(IRNUH, I) 

.  .  ENCODE(2,8110fHDREC(5))I 

.  .  FORMAT( 12) 

.  .  CALL  BUFOUT(LFN , HDREC, 112 , IE OF) 

.  END  FOR 
END  LOOP 
FOR  1-1,112 
.  MBUF(I)*0 
END  FOR 
FOR  I-l.LIM 
,  LFN-60+I 
.  END  FILE  LFN 

.  CALL  DS TAT (LFN, STATS, ILAST) 

#  CALL  DPO  S ( LFN , 2 ) 

.  MBUF(112)-INEXT(I) 

.  MBUF(111)-MAXBUF 
.  CALL  BUFOUT(LFN,MBUF,112,IEOF) 

.  CALL  DPOS(LFN, ILAST) 

.  CLOSE  LFN 
END  FOR 
STOP  PAU 

END  . 

SUBROUTINE  RANG ER ( RLAT, RLON, SLAT, SLON, RAN) 
DR-3 ,141592654/180, 

DY- RLAT- SLAT 

DX-(ELON~SLON)*COS( (RLAT+SLAT)*DR/2. ) 

RAN-1 . 852*SQRT (DX*DX+DY*DY )*60 . 

RETURN 

END 
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SUBROUTINE  ITMCNT,  CNTITM,  ULCNT 
INTEGER  TRAY (7 ),YR,HO,DA,HR,MN,SC,MS 
COMMON  / ITCM/TRAY , CSEC , JULD 
INTEGER *6  CSEC, TEMP 

EQUIVALENCE  (TRAY ( 1 )  ,  YR  )  ,  ( TRAY ( 2 ) ,  MO  )  ,  ( TRAY ( 3 )  , DA  )  , 
+(TRAY(4)  ,HR) ,  (TRAY(5)  ,MN) ,  (TRAY (6) ,  SC) ,  (TRAY (7  )  ,MS ) 

TMCENT  CONVERTS  TIME  TO  CENTURY  SEC  AND  MILLISECOND 
CENTTM  CONVERTS  CENTURY  SEC  TO  REGULAR  TIME. 

THESE  ROUTINES  GOOD  FOR  ALL  OF  1900'S  AND  UP 

JULD-0 

ENTRY  ULCNT 
IF  (YR.GT.99) 

.  YR-YR-1900 

END  IF 

IDAY-  (146 1*YR-1 )  /4 
MODYR-MOD(YR,4) 

IF  (M0DYR.EQ.0) 

.  MDDYR-1 
ELSE 

.  MODYR-O 
END  IF 

IF  (JULD.EQ.O) 

.  JDAY*30.55*(MO+2) 

.  IF  (M0.GT.2) 

.  .  JDAY- JDAY-93+MODYR 

•  EL  SE 

.  .  JDAY-JDAY-91 

.  END  IF 
.  JULD-JDAY+DA 
END  IF 

IDAY  - IDA Y+  JULD 
CSEC- IDAY*86 400.0 

CSEC-CSEC+3600.0*HR+60.0*MN+SC*1.0 

TEMP-1000 

CSEOCSEC*TEMP 

TEMP- MS 

CSEC-CSEC+TEMP 

YR-YR+1900 

RETURN 

CODING  FOR  CENTTM 

ENTRY  CNTITM 
TEMP-MOD2 ( CSEC , 1 000D ) 

MS-TEMP 

TEMP- CSEC /1000D 
FSEC-TEMP 

IDAY-AMOD(FSEC, 86400.0) 

HR-IDAY/3600 

IDAY»MOD(IDAY,36O0) 

MN-IDAY/60 

SC-MOD(IDAY,60) 

IDAY-PSEC/86 400.0 
YR-IDAY/365.25 
IDAY-IDAY-( ( 146 1*YR-1 ) /4) 

JULD- IDAY 
HDDYR-M0D(YR,4) 

IF  (MODYR.EQ.O) 

.  MODYR-1 
ELSE 

.  MODYR-O 
END  IF 

IF  (IDAY.  GT.  ( 59+MODYR) ) 

.  JDAY- IDAY+9  3-HDDYR 
ELSE 

.  JDAY- IDAY+9 1 
END  IF 

MO-( JDAY/30.55) 

DA-JDAY-1FIX(M0*30.55) 

MO- MO-2 
YR-YR+1900 
RETURN 
END 
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1:  SUBROUTINE  CNVNEG ( IBUF , LEN ) 

2:  INTEGER  IBUF(4096) 

3:  FOR  I  -  l.LEN 

4:  IF  (IBUF(I).GE. 32768) 

5:  IBUF(I)  -  IBUF(I)  -  65536 

6:  ENDIF 

7 :  ENDFOR 

8:  RETURN 

9:  END 


1:  SUBROUTINE  BUFOUT(LFN, OUT,M,K, R) ,  BUFIN(LFN,OUT,M,K,N) 

2:  C  SHORTERS  CODING  FOR  BUFFER  IN/OUT  WORK 
3:  DIMENSION  OUT(l) 

4:  BUFFER  OUT(LFN,OUT,B,M,K,N) 

5:  1  CALL  STATUS(LFN) 

6:  GOTO  (1,2,2)  ,K 

7 :  2  RETURN 

8:  ENTRY  BURIN 

9:  BUFFER  IN(LFH,OUT,B,M,K,N) 

10:  3  CALL  STATOS(LFN) 

11:  GOTO  (3,4,4)  ,K 

12:  RETURN 

13:  END 


Program  notes: 

Harris  structured  FORTRAN  66  and  77  are  the  versions  of  FORTRAN 
language  used  throughout  these  programs.  The  user  callable  library 
subroutines  DATE,  TIME,  BTIME  and  ETIME  are  described  in  the  FORTRAN 
Reference  Manual  0861004—003  sections  9.3.3,  9.3.7  and  9.3.30. 
Statements  BUFFER  IN  and  BUFFER  OCT  with  the  associated  library 
subroutine  STATUS  are  used  throughout  to  permit  records  of  arbitrary 
length  and  format  to  be  read  and  written  asynchronously.  Detailed 
descriptions  can  be  found  in  sections  6.13  and  9.3.27  of  the  manual. 


